CODEWITHSUNDEEP
excelvba
Alexey
Alexey

Reputation: 23

How to loop through several workbooks and copy data from each

I have a list of files and code to open them, but I am not looping through i. The script replaces the data entered, and doesn't offset anything.

How can I correct the rows count when looping through several files?

Sub GetFileCopyData()
    Dim SrcWbk As Workbook
    Dim DestWbk As Workbook
    Dim k As Long
    Dim i As Long
    Dim wb As Workbook

    Set DestWbk = ThisWorkbook

    Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), _
      *.xls*", Title:="Select a File", MultiSelect:=True)

    If VarType(Fname) = vbBoolean Then Exit Sub

    '''For i = 1 To UBound(Fname)
    For Each file In Fname
        MsgBox ("each enetered")
        Set SrcWbk = Workbooks.Open(file, UpdateLinks:=False)
        i = 1
        MsgBox ("set done")
        k = SrcWbk.Sheets("Ëèñò2").Cells(2, 1).End(xlDown).Row

        SrcWbk.Sheets("Ëèñò2").Range(SrcWbk.Sheets("Ëèñò2").Cells(2, 1), _
          SrcWbk.Sheets("Ëèñò2").Cells(k, 5)).Copy

        DestWbk.Sheets("Consolidated").Range(DestWbk.Sheets("Consolidated").Cells(i + 1, 1), _
          DestWbk.Sheets("Consolidated").Cells(k + i - 1, 5)).PasteSpecial

        i = i + k
        MsgBox ("before close")
        SrcWbk.Close True
        MsgBox ("before next")
    Next file
    '''Next i
End Sub

Upvotes: 0

Views: 74

Answers (1)

Mikku
Mikku

Reputation: 6654

Problem: You are re-Initiating your i in every iteration. So the data is pasted at the same place for each file.

Solution: Move i = 1 out of the loop. Put it before For Each file In Fname

Code:

Sub GetFileCopyData()
   Dim SrcWbk As Workbook
   Dim DestWbk As Workbook
   Dim k As Long
   Dim i As Long
   Dim wb As Workbook

   Set DestWbk = ThisWorkbook

   fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File", MultiSelect:=True)

   If VarType(fname) = vbBoolean Then Exit Sub

    i = 1
   '''For i = 1 To UBound(Fname)
   For Each file In fname
       MsgBox ("each enetered")
       Set SrcWbk = Workbooks.Open(file, UpdateLinks:=False)
       MsgBox ("set done")
       k = SrcWbk.Sheets("Ëèñò2").Cells(2, 1).End(xlDown).row
       SrcWbk.Sheets("Ëèñò2").Range(SrcWbk.Sheets("Ëèñò2").Cells(2, 1), SrcWbk.Sheets("Ëèñò2").Cells(k, 5)).Copy
       DestWbk.Sheets("Consolidated").Range(DestWbk.Sheets("Consolidated").Cells(i + 1, 1), DestWbk.Sheets("Consolidated").Cells(k + i - 1, 5)).PasteSpecial
       i = i + k
       MsgBox ("before close")
       SrcWbk.Close True
       MsgBox ("before next")
   Next file
   '''Next i
End Sub

Upvotes: 1

Related Questions