title: Loop through all xls files in directory, copy range, and paste to docx file?
body: <p>I have around 500 Excel files in one directory. All files have a table on the first sheet (same size). My client wants them all in one word file. I am not an VBA expert an experimented with a code I found online. I got it so far to loop through all files in a directory. It also selects and copies the specific range. But how do I get the transfer to a word file? </p>
  
  <p>Here is what I did:</p>
  
  <pre><code>Sub LoopAllExcelFilesInFolder()
      Dim wb As Workbook
      Dim myPath As String
      Dim myFile As String
      Dim myExtension As String
      Dim FldrPicker As FileDialog
      'Optimize Macro Speed
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      Application.Calculation = xlCalculationManual
      'Retrieve Target Folder Path From User
      Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
      With FldrPicker
          .Title = "Select A Target Folder"
          .AllowMultiSelect = False
          If .Show &lt;&gt; -1 Then GoTo NextCode
          myPath = .SelectedItems(1) &amp; "\"
      End With
      'In Case of Cancel
  NextCode:
      myPath = myPath
      If myPath = "" Then GoTo ResetSettings
      'Target File Extension (must include wildcard "*")
      myExtension = "*.xls"
      'Target Path with Ending Extention
      myFile = Dir(myPath &amp; myExtension)
      'Loop through each xls files dir
      Do While myFile &lt;&gt; ""
          'Set variable equal to opened workbook
          Set wb = Workbooks.Open(Filename:=myPath &amp; myFile)
          'Select range and copy
          Range("G10:M25").Select
          Selection.Copy
          'Save and Close Workbook
          wb.Close SaveChanges:=True
          'Get next file name
          myFile = Dir
          DoEvents
      Loop
      'Message Box when tasks are completed
      MsgBox "Task Complete!"
  ResetSettings:
      'Reset Macro Optimization Settings
      Application.EnableEvents = True
      Application.Calculation = xlCalculationAutomatic
      Application.ScreenUpdating = True
  End Sub
  </code></pre>