title: Extract rows from spreadsheet and put into multiple spreadsheets
body: <p>I want to loop through a folder with Excel files and for each file, loop through each row (starting at row 4) and for each row, look at what value is in column "d" and paste that row into a particular Excel file named whatever the value in column "d" was.</p>
  
  <ul>
  <li><p>If the file doesn't exist, it would need to be created before pasting the row (start at row 4 when pasting). The file name of the newly created file would be whatever value was in column "d".</p></li>
  <li><p>If the file exists, the row being copied would be appended (value of column d in given row). </p></li>
  </ul>
  
  <p>My code doesn't want to loop through all the files.</p>
  
  <pre><code>Sub CopyRowsIntoAppSpreadsheet()
  
  Dim LastRow As Integer, i As Integer, erow As Integer
  Dim AppFileName As String
  Dim FilePath As String
  Dim MyFolder As String
  Dim MyFile As String
  Dim wbk As Workbook
  
  On Error Resume Next
  
  Application.ScreenUpdating = False
  
  With Application.FileDialog(msoFileDialogFolderPicker)
  
      .Title = "Please select a folder"
      .Show
      .AllowMultiSelect = False
  
      If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
          MsgBox "You did not select a folder"
          Exit Sub
      End If
  
      MyFolder = .SelectedItems(1) &amp; "\" 'Assign selected folder to MyFolder
  
  End With
  
  MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
  
  'Loop through all files in a folder until DIR cannot find anymore
  
  Do While MyFile &lt;&gt; “”
  
      'Opens the file and assigns to the wbk variable for future use
      Set wbk = Workbooks.Open(FileName:=MyFolder &amp; MyFile)
  
      'Replace the line below with the statements you would want your macro to perform
      LastRow = ActiveSheet.Range("A" &amp; Rows.Count).End(xlUp).Row
  
      For i = 4 To LastRow
  
          Range("d" &amp; i).Select
          AppFileName = Selection.Value
          Rows(i).Select
          Selection.Copy
          FilePath = "C:\Users\Gary\Desktop\Ex Folder\" &amp; AppFileName &amp; ".xlsx"
  
          If Not Dir(FilePath, vbDirectory) = vbNullString Then
              Workbooks.Open FileName:=FilePath
              Worksheets("Sheet1").Select
              erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
              ActiveSheet.Cells(erow, 1).Select
              ActiveSheet.Paste
              Cells.Select
              Cells.EntireColumn.AutoFit
              ActiveWorkbook.Save
              ActiveWorkbook.Close
              Application.CutCopyMode = False
  
          Else
              Dim wkb As Workbook
              Set wkb = Workbooks.Add
              Rows(4).Select
              ActiveSheet.Paste
              wkb.SaveAs FileName:=FilePath
              Cells.Select
              Cells.EntireColumn.AutoFit
              ActiveWorkbook.Save
              ActiveWorkbook.Close
              Application.CutCopyMode = False
  
          End If
  
      Next i
  
      MyFile = Dir 'DIR gets the next file in the folder
  
  Loop
  
  Application.ScreenUpdating = True
  
  MsgBox "Macro has completed! Woot! Woot!"
  
  End Sub
  </code></pre>