Home > Software design >  Copy the content of multiple Excel files which are inside a folder and paste it in the same workshee
Copy the content of multiple Excel files which are inside a folder and paste it in the same workshee

Time:01-18

The code I have below does more or less that what title says but every time it reads one file creates a new worksheet and pastes the content there

Code

Sub fileLoop()

    Dim mypath As String, myfile As String
    mypath = "C:\Users\xxxx\Desktop\test macro\"
    myfile = Dir(mypath & "*.xlsx")
    Dim ws As Worksheet
    
    Do While myfile <> ""
        
        Dim wb As Workbook
        Set wb = Workbooks.Open(mypath & myfile)
        Set ws = wb.Sheets(1)
        For Each ws In wb.Worksheets
            ws.Copy after:=ThisWorkbook.ActiveSheet
        Next
        
        wb.Close
        myfile = Dir
    Loop
    
End Sub

Files I have

enter image description here

What I get

enter image description here

enter image description here

What I need

enter image description here

I tried changing this line to get the content of files in the same worksheet

    For Each ws In wb.Worksheets
        ws.Copy after:=ThisWorkbook.ActiveSheet
    Next
    

CodePudding user response:

Change ws.Copy after:=ThisWorkbook.ActiveSheet

To ws.UsedRange.Copy ActiveSheet.Cells(ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 1,1)

Also the Set ws = wb.Sheets(1) is useless because you are just resetting it without use in the very next statement!

CodePudding user response:

Try playing around with this:

Option Explicit

Sub fileLoop()

    Dim mypath As String, myfile As String
    mypath = "C:\Users\xxxx\Desktop\test macro\"
    myfile = Dir(mypath & "*.xlsx")
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim rngTarget As Range
    Dim numRows As Integer

    Set rngTarget = ThisWorkbook.Worksheets("Hoja1").Range("A2:M2")

    Do While myfile <> ""

        Set wb = Workbooks.Open(mypath & myfile)

        For Each ws In wb.Worksheets
            numRows = ws.Range("A1").Offset(Rows.Count - 1).End(xlUp).Row
            rngTarget.Resize(numRows).Value = ws.Range("A2:M2").Resize(numRows).Value
            Set rngTarget = rngTarget.Offset(numRows)
        Next ws

        wb.Close
        myfile = Dir
    Loop

    Set rngTarget = Nothing
    Set wb = Nothing
End Sub
  • Related