Question

我想在我的硬盘驱动器上打开filepath中的所有工作簿，然后将表格2中的表格数据复制到Master工作簿中。

我找到了这段代码并对其进行了修改以满足我的需求，但我陷入困境。

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

这个星期五有什么帮助吗？

Answer 1

根据您的代码，我们不清楚目标表格（您要粘贴的目标表格）是Worksheet，是Sheet1还是Worksheets("DataÖnskemål")。

无论如何，在我的代码中，它粘贴到Sheet1，如果您有其他意思，请告诉我。

<强>代码

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

我建议改用FileSystemObject：

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

您必须将Microsoft Scripting Runtime引用添加到项目中。您可以阅读更多here

在filepath中打开工作簿，将工作表2复制到Masterworkbook

2 个答案: