Macro to populate sheet in active workbook with values from another workbook's sheets

[noname91]

Hi all,

I've modified a macro to pull values from other workbooks' sheets and use it to populate the active workbook's Sheet1. So far, it works with the getting values from other workbooks' sheets part, but the part I'm having trouble with is populating the active workbook's sheet. The latter is mostly working, but the problem is I'm only able to populate the values from the second sheet of an external workbook that contains two sheets. However, the print debug shows the values are being grabbed correctly from both sheets, one after the other.

Right now, the vba populates the active sheet with values from external workbook sheet1, but instead of continuing to the next empty row, it begins populating from the start again, this time with the external workbook's sheet2, overwriting the previous values that were grabbed. Here is my code (please ignore some of the xperimental commented code):

Sub DataPull()
  Dim fnameList, fnameCurFile As Variant
  Dim countFiles, countSheets As Integer
  Dim wksCurSheet As Worksheet
  Dim wbkCurBook, wbkSrcBook As Workbook
  Dim cellRange As Range
  Set cellRange = Range("A1:A5")
  Dim Cell As Range
  Dim val As String

  Dim ii As Integer
Dim j As Integer

  fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

  If (vbBoolean <> VarType(fnameList)) Then

    If (UBound(fnameList) > 0) Then
      countFiles = 0
      countSheets = 0

      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual

      Set wbkCurBook = ActiveWorkbook

      For Each fnameCurFile In fnameList
          countFiles = countFiles + 1

          Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)

          For Each wksCurSheet In wbkSrcBook.Sheets
              countSheets = countSheets + 1
              
            For j = 1 To 10
            
           'Get values from each individual sheet
                For ii = 1 To 5
                    
                    If wksCurSheet.Cells(j, ii).Value = "" Then
                      Exit For
                    End If
                    
                    Debug.Print wksCurSheet.Cells(j, ii).Value 'working
                    
                    Cells(j, ii).Value = wksCurSheet.Cells(j, ii).Value
                                    
'                        For Each Cell In Sheets("Sheet1").Range("A1:X10")
'                            Cell.Offset(j, ii).Value = wksCurSheet.Cells(j, ii).Value
'                        Next Cell
                    
                Next ii
               'Debug.Print wksCurSheet.Range("A1").Value 'working
               'Debug.Print wksCurSheet.Range("A1:E1").Value
               
               'Debug.Print wksCurSheet.Cells(1, 4).Value 'working
               
               If wksCurSheet.Cells(j, 1).Value = "" Then
                      Exit For
                    End If

            Next j
          Next

          wbkSrcBook.Close SaveChanges:=False

      Next

      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic

      'MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
    End If

  Else
      'MsgBox "No files selected", Title:="Merge Excel files"
  End If
End Sub

How would I get it to continue populating the values in sequence (next empty row), after the current sequence ends?

Thanks!

 

[Micron]

Find the last row with data and input the data not at that row, but one row beloe. TONS of code examples out there & several variations on the method. Any method that uses UsedRange can be problematic in that even cell interior colouring is part of the UsedRange, so I'd avoid those. Here's two methods that don't use UsedRange:
This one only considers column E
Lrow = Sheets("Sheet8").Cells(Rows.Count, "E").End(xlUp).Row

This one uses column number reference but uses the Find method, which seems to be the preferred method.
Lrow = Sheets("002").Column(3).Cells.Find(What:=Range("A1"), SearchOrder:=xlColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row

You might want to look into the Find method because there are several options for the parameters.

 

[Alex Blakenburg]

Expanding on Micron's comment see if the below helps.
I have tried to change your code as little as possible and left in all your commented out code.
Note: You are mixing and matching on your variable names, which I find confusing ie your wksCurSheet is in the workbook wbkSrcBook and not in wbkCurBook. In the below I have changed anything belonging to Src to use Src and anything belonging to Cur to use Cur

  Dim fnameList, fnameSrcFile As Variant                                     ' XXX Changed
  Dim countFiles, countSheets As Integer
  Dim wksCurSheet As Worksheet, wksSrcSheet As Worksheet    ' XXX Changed
  Dim wbkCurBook As Workbook, wbkSrcBook As Workbook        ' XXX Changed
  Dim cellRange As Range
  Set cellRange = Range("A1:A5")
  Dim Cell As Range
  Dim val As String

  Dim ii As Integer
  Dim j As Integer
  Dim rowCurLast As Long                                    ' XXX Added

  fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

  If (vbBoolean <> VarType(fnameList)) Then

    If (UBound(fnameList) > 0) Then
      countFiles = 0
      countSheets = 0

      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual

      Set wbkCurBook = ActiveWorkbook
      Set wksCurSheet = wbkCurBook.ActiveSheet
      rowCurLast = wksCurSheet.Range("A" & Rows.Count).End(xlUp).Row   ' XXX Get the last row

      For Each fnameSrcFile In fnameList
          countFiles = countFiles + 1

          Set wbkSrcBook = Workbooks.Open(Filename:=fnameSrcFile)

          For Each wksSrcSheet In wbkSrcBook.Sheets
              countSheets = countSheets + 1
             
            For j = 1 To 10
                If wksSrcSheet.Cells(j, 1).Value = "" Then              ' XXX Moved to the top of the loop
                    Exit For
                End If
               
                rowCurLast = rowCurLast + 1                             ' XXX Advance Last Row
           
           'Get values from each individual sheet
                For ii = 1 To 5
                   
                    If wksSrcSheet.Cells(j, ii).Value = "" Then
                      Exit For
                    End If
                   
                    Debug.Print wksSrcSheet.Cells(j, ii).Value 'working
                   
                    wksCurSheet.Cells(rowCurLast, ii).Value = wksSrcSheet.Cells(j, ii).Value    ' XXX Write to new last row
                                   
'                        For Each Cell In Sheets("Sheet1").Range("A1:X10")
'                            Cell.Offset(j, ii).Value = wksCurSheet.Cells(j, ii).Value
'                        Next Cell
                   
                Next ii
               'Debug.Print wksCurSheet.Range("A1").Value 'working
               'Debug.Print wksCurSheet.Range("A1:E1").Value
              
               'Debug.Print wksCurSheet.Cells(1, 4).Value 'working
            Next j
          Next

          wbkSrcBook.Close SaveChanges:=False

      Next fnameSrcFile

      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic

      'MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
    End If

  Else
      'MsgBox "No files selected", Title:="Merge Excel files"
  End If
End Sub

 

[noname91]

Thank you @Micron and @Alex Blakenburg !

Alex Blakenburg's solution works perfectly, but I will need to examine both solutions.

 

[Micron]

Don't worry about mine. It was a line, a worm and a hook.

 

[Alex Blakenburg]

It was a line, a worm and a hook.

And it did it's job . Love that phrase.

Thank you @Micron and @Alex Blakenburg !

Alex Blakenburg's solution works perfectly, but I will need to examine both solutions.

Glad we could help and thanks for acknowledging all contributors.