在文件路径中打开工作簿并将工作表2复制到Masterworkbook

Question

I would like to open all workbooks in a filepath on my hard-drive and then copy table data from sheet 2 to Master workbook with the name of Master.

I found this code and have modified it to suit my needs but I'm stuck.

Sub LoopThroughDirectory()

Dim MyFile As String
Dim erow
Dim Filepath As String

Filepath = "C:\home\Se\058 \dxakmh\Desktop\TestMiljö\Prognosverktyg\Sektionsfil\Gruppfiler"

MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
    If MyFile = “master.xlsm” Then
        Exit Sub
    End If

    Workbooks.Open (Filepath & MyFile)
    Worksheets("FärdigÖnskemål").Range("A4:D4").Select
    ActiveWorkbook.Close

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets("DataÖnskemål").Range(Cells(erow, 1), Cells(erow, 4))

    MyFile = Dir
Loop

End Sub

Any help this friday?

Answer 1

According to your code, it's not clear what Worksheet is the destination sheet (the one you want to paste to), is it Sheet1 or Worksheets("DataÖnskemål") .

Anyway, in my code it pastes to Sheet1 , let me know if you meant something else.

Code

Option Explicit

Sub LoopThroughDirectory()

Dim MyFile As String
Dim erow As Long
Dim Filepath As String
Dim wb As Workbook

Filepath = "C:\home\Se\058 \dxakmh\Desktop\TestMilj?\Prognosverktyg\Sektionsfil\Gruppfiler\"

MyFile = Dir(Filepath)
Do While MyFile <> ""
    If Not MyFile Like "master.xlsm" Then
        Set wb = Workbooks.Open(Filepath & MyFile)

        erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        wb.Worksheets("DataÖnskemål").Range("A4:D4").Copy Destination:=Sheet1.Range("A" & erow)

        wb.Close False
    End If
    MyFile = Dir()
Loop

End Sub

Answer 2

I would recommend using FileSystemObject instead:

Sub LoopThroughDirectory()

Dim MyFile As File
Dim erow As Long
Dim Filepath As String
Dim wb As Workbook
Dim FSO As New Scripting.FileSystemObject

Filepath = "C:\home\Se\058 \dxakmh\Desktop\TestMilj?\Prognosverktyg\Sektionsfil\Gruppfiler"

For Each MyFile In FSO.GetFolder(Filepath).Files
    If Not MyFile.Name Like "master.xlsm" Then
        Debug.Print MyFile.Path
        Set wb = Workbooks.Open(MyFile.Path)

        erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        wb.Worksheets("DataÖnskemal").Range("A4:D4").Copy Destination:=Sheet1.Range("A" & erow)

        wb.Close False
    End If
Next

End Sub

You have to add Microsoft Scripting Runtime reference to your project. You can read more here