Loop through Rows

[rollingzep]

Hi All,

I have this code which loops through all the files in a folder and copies the rows and pastes the values into the Target worksheet of the new Workbook.
It works well.
But this code reads only the first row values from all the files. How do I read all the rows in all the files? How to specify the range?

Const FOLDER_PATH = "S:\IT\GP\DigitalSubscription\Users\"

Sub ImportWorksheets()
   '=============================================
   '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
  
   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("Existing Users")
  
   '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
      
      'import the data
      With wsTarget
         .Range("A" & rowTarget).Value = wsSource.Range("C2").Value
         .Range("B" & rowTarget).Value = wsSource.Range("A2").Value
         .Range("C" & rowTarget).Value = wsSource.Range("B2").Value
        
         'optional source filename in the last column
         .Range("N" & 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

TIA

 

[Joe4]

So, it looks like you are wanting to copy over columns A, B, and C.
For every row in your source file that has data, will all three columns ALWAYS have data in the last row with data, or just certain columns?
We are just trying to determine the best column to look at in the source file to determine where the data ends.

 

[rollingzep]

So, it looks like you are wanting to copy over columns A, B, and C.
For every row in your source file that has data, will all three columns ALWAYS have data in the last row with data, or just certain columns?
We are just trying to determine the best column to look at in the source file to determine where the data ends.

all the three contain data in all sheets

 

[Joe4]

Try this code:

Sub ImportWorksheets()
   '=============================================
   '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 lrS As Long
   Dim lrT As Long
  
   lrT = 1
  
   '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("Existing Users")
  
   '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
      
      'Find last row in column A with data
      lrS = wsSource.Cells(Rows.Count, "A").End(xlUp).Row
      
      'import the data
      With wsTarget
         wsSource.Range(Cells(2, "C"), Cells(lrS, "C")).Copy .Cells(lrT + 1, "A")
         wsSource.Range(Cells(2, "A"), Cells(lrS, "A")).Copy .Cells(lrT + 1, "B")
         wsSource.Range(Cells(2, "B"), Cells(lrS, "B")).Copy .Cells(lrT + 1, "C")
        
         'optional source filename in the last column
         .Range(.Cells(lrT + 1, "N"), .Cells(lrT + lrS - 1, "N")).Value = sFile
      End With
      
      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      lrT = wsTarget.Cells(Rows.Count, "A").End(xlUp).Row
      sFile = Dir()
   Loop
  
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
  
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
   
End Sub

 

[rollingzep]

Try this code:

Sub ImportWorksheets()
   '=============================================
   '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 lrS As Long
   Dim lrT As Long
 
   lrT = 1
 
   '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("Existing Users")
 
   '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
    
      'Find last row in column A with data
      lrS = wsSource.Cells(Rows.Count, "A").End(xlUp).Row
    
      'import the data
      With wsTarget
         wsSource.Range(Cells(2, "C"), Cells(lrS, "C")).Copy .Cells(lrT + 1, "A")
         wsSource.Range(Cells(2, "A"), Cells(lrS, "A")).Copy .Cells(lrT + 1, "B")
         wsSource.Range(Cells(2, "B"), Cells(lrS, "B")).Copy .Cells(lrT + 1, "C")
      
         'optional source filename in the last column
         .Range(.Cells(lrT + 1, "N"), .Cells(lrT + lrS - 1, "N")).Value = sFile
      End With
    
      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      lrT = wsTarget.Cells(Rows.Count, "A").End(xlUp).Row
      sFile = Dir()
   Loop
 
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
 
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
 
End Sub

It worked perfectly!