尝试删除每个Excel文件中的第一张工作表,然后从每个选项卡复制到具有相同选项卡名称的主工作簿

时间:2018-07-12 17:42:14

标签: vba excel-vba

基本上,我的宏现在正在执行的操作是通过一个文件夹并选择每个excel文件,然后删除第一个名为some_Accounts的选项卡,然后将粘贴数据复制到工作表名称匹配的主工作簿中。

我遇到了一个错误       “如果wsDst.Name = wsSrc.Name那么”

未设置或定义对象变量。有人可以指出问题出在哪里吗?

这是我的代码

Sub ProjectMacro()
    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
    Dim LC As Long
    Dim s As Worksheet, t As String
    Dim i As Long, K As Long
    K = Sheets.Count

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

    Set wbDst = ThisWorkbook
    MyPath = "C:\Users\Adam\Desktop\some 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

            For i = K To 1 Step -1
                t = Sheets(i).Name
                If t = "some_Accounts" Then
                    Application.DisplayAlerts = False
                    Sheets(i).Delete
                    Application.DisplayAlerts = True
                End If
            Next i

            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

1 个答案:

答案 0 :(得分:0)

您有这行:

 Set wsDst = wbDst.Worksheets(wsSrc.Name)

关闭所有错误后,立即

 On Error Resume Next

On Error Resume Next删除,因为设置wsDST的下一行失败100%,因此您的wsDst未设置,因此您无法获得wsDst.NameIf的声明。

为什么Set wsDst行失败是另外一个问题