解决下标超出范围错误

时间:2015-03-29 22:59:16

标签: vba excel-vba excel

我正在运行一个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工作簿打开后的代码不会......

1 个答案:

答案 0 :(得分:1)

wkbk2中的工作表应与CSV文件名相同(不带扩展名) - 但这不一定是&#34; Time Login-Logout&#34;因为您在致电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