Question

我对VBA非常陌生。今天第一次尝试。

我正在寻找一个Excel宏，它将位于桌面上某个文件夹中的5个工作簿的最后两个工作表复制到一个名为output_DDMMYYHHMMSS.xlsx

的新工作簿中

我能够将所有5个工作簿中的所有工作表复制到输出工作簿。以下是使用的代码： Sub MergeExcelFiles（）

Dim fnameList, fnameCurFile As Variant
Dim countFiles, countSheets As Integer
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook

fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

Path = "C:\Users\se\Desktop"
outputName = "output.xlsx"

If (vbBoolean <> VarType(fnameList)) Then

    If (UBound(fnameList) > 0) Then
        countFiles = 0
        countSheets = 0
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        Set wbkCurBook = ActiveWorkbook
        For Each fnameCurFile In fnameList
            countFiles = countFiles + 1
            Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
            For Each wksCurSheet In wbkSrcBook.Sheets
                countSheets = countSheets + 1
                wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
            Next
            wbkSrcBook.Close SaveChanges:=False
        Next
        fName = Application.GetSaveAsFilename
        wbkCurBook.SaveAs Filename:=fName
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic

        MsgBox "Procesed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
    End If
Else
    MsgBox "No files selected", Title:="Merge Excel files"
End If

End Sub

Answer 1

工作簿中的所有工作表都有Index属性。索引1表示第一张，索引2表示第二张，依此类推。所以最后一张表的索引等于Sheets.Count。知道这一点，尝试更换这部分：

For Each fnameCurFile In fnameList
            countFiles = countFiles + 1
            Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
            For Each wksCurSheet In wbkSrcBook.Sheets
                countSheets = countSheets + 1
                wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
            Next
            wbkSrcBook.Close SaveChanges:=False
        Next

并使用此代码：

For Each fnameCurFile In fnameList
            Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
             countFiles = countFiles + 1
            countSheets = wbkSrcBook.Sheets.Count 'total sheets in this workbook
            For Each wksCurSheet In wbkSrcBook.Sheets
                'last sheet got an index equal to countSheets.
                'the sheet before the last one will be then countSheets-1
                If wksCurSheet.Index = countSheets Or wksCurSheet.Index = (countSheets - 1) Then wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
            Next
            wbkSrcBook.Close SaveChanges:=False
        Next

另外，替换行：

MsgBox "Procesed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"

使用：

MsgBox "Procesed " & countFiles & " files" & vbCrLf & "Merged 2 worksheets", Title:="Merge Excel files"

宏VBA帮助复制特定的工作表

1 个答案: