解决下标超出范围错误

Question

我正在运行 VBA 代码来合并一些 Excel 工作簿并对其执行操作，但在合并工作簿后它不断返回 下标超出范围错误...请我需要帮助！

Sub ConsolidateAll()

    Dim Path As Variant
    Dim Name As Variant
    Dim wkbConsol As Workbook
    Dim wbk2 As Workbook
    Dim wksConsol As Worksheet
    Dim wkbOpen As Workbook
    Dim wksOpen As Worksheet
    Dim FolderName As String
    Dim FileName As String
    Dim Cnt As Long

    'Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wkbConsol = ActiveWorkbook
    Set wksConsol = wkbConsol.Worksheets(1)

    'Change the path accordingly
    FolderName = ThisWorkbook.Path & "\New folder"

    If Right(FolderName, 1) <> "\" Then FolderName = FolderName & "\"

    FileName = Dir(FolderName & "*.csv")

    Cnt = 1
    Do While FileName <> ""
        If FileName <> wkbConsol.Name Then
            Application.StatusBar = "Opening " & FileName & "..."
            Set wkbOpen = Workbooks.Open(FolderName & FileName)
            Set wksOpen = wkbOpen.Worksheets(1)
            Application.StatusBar = "Copying the data from " & FileName & "..."
            With wksOpen.UsedRange
                If Cnt = 1 Then
                    .Copy
                    wksConsol.Cells(1, "A").PasteSpecial Paste:=xlPasteValues
                Else
                    .Offset(1, 0).Resize(.Rows.Count - 1).Copy
                    wksConsol.Cells(wksConsol.Rows.Count, "A").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
                End If
            End With
            wkbOpen.Close savechanges:=False
            Application.StatusBar = FileName & " closed..."
        End If
        FileName = Dir
        Cnt = Cnt + 1
    Loop

    Path = ThisWorkbook.Path & "\"
    Name = Dir(Path & "*Time Login-Logout*.csv")
    Set wbk2 = Workbooks.Open(Path & Name)

    wbk2.Activate
    Sheets("Time Login-Logout").Activate
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents

    wkbConsol.Activate
    Sheets("Sheet1").Activate

    Columns("A:I").Select
    Selection.Copy

    wbk2.Activate
    Sheets("Time Login-Logout").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'Application.StatusBar = False
    'Application.ScreenUpdating = True

End Sub

合并工作，但是打开wbk2工作簿后的代码不...

Answer 1

wkbk2 中的工作表应与 CSV 文件名同名（不带扩展名） - 但不一定是“时间登录-注销”，因为您在调用 Dir() 时使用了通配符.

但是，由于工作簿中只有一张从 CSV 打开的工作表，因此使用 wkbk2.Sheets(1) 代替是安全的。

试试这个：

    '...
    Path = ThisWorkbook.Path & "\"
    Name = Dir(Path & "*Time Login-Logout*.csv")
    Set wbk2 = Workbooks.Open(Path & Name)

    With wbk2.Sheets(1)
        .Range("A1").CurrentRegion.ClearContents
        .Range("A:I").Value = wkbConsol.Sheets("Sheet1").Range("A:I").Value
    End With

End Sub