Question

我需要一些关于以下代码的帮助，基本上我在一个文件夹中有大约50个excel文件，我想将每个excel文件中的数据复制到主文件中。每个文件中有3个工作表，名称为6D6 Cash，6D6 Position和6D6 Transactions和masterworkbook也有这些选项卡，例如宏将所有数据从每个excel文件中的6D6现金工作表复制到主工作簿中的6D6现金工作表并且新数据将低于最后填充的行。此外，每个excel文件中的行都有标题，因此显然不会进入。

出于某种原因，它不起作用，因为代码根本不起作用。可能是什么原因？

Sub Adam1()
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim lLastRow As Long

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

Set wbDst = ThisWorkbook

MyPath = "C:\Users\Adam\Desktop\6D6 files"
strFilename = Dir(MyPath & "*.xls*", vbNormal)

Do While strFilename <> ""

        Set wbSrc = Workbooks.Open(MyPath & strFilename)

        'loop through each worksheet in the source file
        For Each wsSrc In wbSrc.Worksheets
            'Find the corresponding worksheet in the destination with the same name as the source
            On Error Resume Next
            Set wsDst = wbDst.Worksheets(wsSrc.Name)
            On Error GoTo 0
            If wsDst.Name = wsSrc.Name Then
                lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row + 1
                wsSrc.UsedRange.Copy
                wsDst.Range("A" & lLastRow).PasteSpecial xlPasteValues
            End If
        Next wsSrc

        wbSrc.Close False
        strFilename = Dir()
Loop

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Answer 1

我认为你的字符串不完整。

MyPath = "C:\Users\Adam\Desktop\6D6 files" 
strFilename = Dir(MyPath & "*.xls*", vbNormal)

将返回C：\ Users \ Adam \ Desktop \ 6D6 filessomefile.xls

MyPath = "C:\Users\Adam\Desktop\6D6 files\"  'with the extra slash
strFilename = Dir(MyPath & "*.xls*", vbNormal)

VBA将文件夹中每个文件的内容复制到主工作簿

1 个答案: