VBA multiple file Import to one help.

[mike5]

Hi everyone this is my first time posting on here so be genital lol,
I have a problem with importing multiple files from a folder, I have manged to get the information to import from all the files however it is overlapping the previous data and i need it to go to the line after the first import. so i need it to select info from first file b50 to end as well as g50 to end and D50 to end and the paste that in the file im using in columns a,b,c which is does however once it has done that it goes to file 2 and collects the information from the same columns and pastes it into the file i am using ontop of the stuff that was previously imported

I am attaching what i have done so far, please remember that I am new to VBA. Thanks

Const FOLDER_PATH = "C:\Users\[COLOR=rgb(255, 255, 255)]michael.allen[/COLOR]\Desktop\10cm 10s Cone 100 Bar Template Folder\Tip\"
'REMEMBER END BACKSLASH


Sub test666()

   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim sFile As String           'file to process
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim rowTarget As Long 'output row
   Dim rowSource As Long

   Application.ScreenUpdating = False
Range("A" & Rows.Count).End(xlUp).Offset(0).Select
  
   rowTarget = 2
  
   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub
   End If
  
   'reset application settings in event of error
   On Error GoTo errHandler
   Application.ScreenUpdating = False
  
   'set up the target worksheet
   Set wsTarget = Sheets("Cross Talk (2)")
  
   'loop through the Excel files in the folder
   sFile = Dir(FOLDER_PATH & "*.xls*")
   Do Until sFile = ""
     
      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY
   
    With wsSource
rowSource = Application.Max(.Range("A" & .Rows.Count).End(xlUp).Row, .Range("B" & .Rows.Count).End(xlUp).Row, .Range("C" & .Rows.Count).End(xlUp).Row, .Range("D" & .Rows.Count).End(xlUp).Row, .Range("E" & .Rows.Count).End(xlUp).Row, .Range("F" & .Rows.Count).End(xlUp).Row, .Range("G" & .Rows.Count).End(xlUp).Row)

End With

     
      'import the data
    With wsTarget

.Range("A" & rowTarget & ":A" & rowTarget + rowSource - 2).Value = wsSource.Range("b50:B" & rowSource).Value
.Range("B" & rowTarget & ":B" & rowTarget + rowSource - 2).Value = wsSource.Range("G50:G" & rowSource).Value
.Range("c" & rowTarget & ":c" & rowTarget + rowSource - 2).Value = wsSource.Range("D50:D" & rowSource).Value

Range("A2").Select

     
         'optional source filename in the last column
         .Range("g" & rowTarget).Value = sFile
      End With
     
      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()
     
Loop

errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
  
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing



End Sub

Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

 

[Fluff]

Hi & welcome to MrExcel.
How about

    With wsTarget
      .Range("A" & rowTarget).Resize(rowSource - 49).Value = wsSource.Range("b50:B" & rowSource).Value
      .Range("B" & rowTarget).Resize(rowSource - 49).Value = wsSource.Range("G50:G" & rowSource).Value
      .Range("c" & rowTarget).Resize(rowSource - 49).Value = wsSource.Range("D50:D" & rowSource).Value


     
         'optional source filename in the last column
         .Range("g" & rowTarget).Value = sFile
      End With
     
      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + rowSource - 49
      sFile = Dir()

 

[mike5]

That is perfect, thank you so much but can I ask by changing it from 2 to 49 what has that actually changed (what is it looking for?)
Thanks again

 

[Fluff]

Because your copy range starts from row 50 you need to subtract 49 from rowsource here

.Range("A" & rowTarget).Resize(rowSource - 49)

otherwise you will get 49 rows displaying #N/A
Then you need to increment rowTarget by the number of rows you have just copied which is rowsource -49

 

[mike5]

Thankyou for explaining it to me, one final thing do you know if there is a way to change the constant folder path to one i select but wont have to select again once it starts the loop?

 

[Fluff]

How about

Sub Mike()

   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim Fldr As Variant
   Dim sFile As String           'file to process
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim rowTarget As Long 'output row
   Dim rowSource As Long
   
   With Application.FileDialog(4)
      .InitialFileName = "C:\Users\michael.allen\Desktop\"
      .AllowMultiSelect = False
      If .Show Then Fldr = .SelectedItems(1) & Application.PathSeparator
   End With
   Application.ScreenUpdating = False
   
   rowTarget = 2
   
   'check the folder exists
   
   'reset application settings in event of error
   On Error GoTo errHandler
   
   'set up the target worksheet
   Set wsTarget = Sheets("Cross Talk (2)")
   
   'loop through the Excel files in the folder
   sFile = Dir(Fldr & "*.xls*")
   Do Until sFile = ""
      
      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(Fldr & sFile)
      Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY
      
      With wsSource
         rowSource = Application.Max(.Range("A" & .Rows.Count).End(xlUp).Row, .Range("B" & .Rows.Count).End(xlUp).Row, .Range("C" & .Rows.Count).End(xlUp).Row, .Range("D" & .Rows.Count).End(xlUp).Row, .Range("E" & .Rows.Count).End(xlUp).Row, .Range("F" & .Rows.Count).End(xlUp).Row, .Range("G" & .Rows.Count).End(xlUp).Row)
      End With
      
      
      'import the data
      With wsTarget
         .Range("A" & rowTarget).Resize(rowSource - 49).Value = wsSource.Range("b50:B" & rowSource).Value
         .Range("B" & rowTarget).Resize(rowSource - 49).Value = wsSource.Range("G50:G" & rowSource).Value
         .Range("c" & rowTarget).Resize(rowSource - 49).Value = wsSource.Range("D50:D" & rowSource).Value
         
         'optional source filename in the last column
         .Range("g" & rowTarget).Value = sFile
      End With
      
      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + rowSource - 49
      sFile = Dir()
   Loop
   
errHandler:
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
End Sub

 

[mike5]

you are a legend!!!

 

[Fluff]

Glad to help & thanks for the feedback.