title: VBA Looping through excel files in selected directory - Copy data and paste in different sheets
body: <p>I'm looking to select a directory and then loop through each xlsm file within that directory. For each loop it should open the file, copy a range and paste into the current workbook under a specific sheet.</p>
  
  <p>I.e. the first file will paste into sheet1 the second opened file will past into sheet 2, and so on.</p>
  
  <p>I have some code, now I need help to get it to paste the rang into a sheets.count? or something like that. At the moment it just pastes into sheet 1 because that is static.</p>
  
  <pre><code>Sub Test()
  
  
  Dim wb As Workbook, wb1 As Workbook
  Dim myPath As String
  Dim myFile As String
  Dim myExtension As String
  Dim FldrPicker As FileDialog
  
  Set wb1 = Workbooks(ThisWorkbook.Name)
  
  
  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 = "*.xlsm"
  
  'Target Path with Ending Extention
   myFile = Dir(myPath &amp; myExtension)
  
   'Loop through each Excel file in folder
    Do While myFile &lt;&gt; ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath &amp; myFile)
  
  'Ensure Workbook has opened before moving on to next line of code
    DoEvents
  
  'Copy data from opened workbook
    wb.Sheets("HI Sub-segment split").Range("A1:Z1").Copy
  
  'Paste data into destination workbook
    wb1.Sheet(1).Range("A1:Z1").PasteSpecial xlPasteValues
  
  'Close Workbook
    wb.Close
  
  'Ensure Workbook has closed before moving on to next line of code
    DoEvents
  
  'Get next file name
    myFile = Dir
   Loop
  
  'Message Box when tasks are completed
   MsgBox "Import Complete!"
  
   ResetSettings:
  
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  
  End Sub
  </code></pre>