Question

我想将以下代码更改为仅复制第一个工作表，而不是每个工作表。我是VBA的完全菜鸟，所以我不确定

 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)

    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

            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Processed " & 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

我以为我可以改变

wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)

到

wksCurSheet(1).Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)

但是很明显那是行不通的

谢谢！

Answer 1

您必须删除For-Next循环-这是每张纸上正在使用的循环。如果您只想复制第一张纸，请使用

wbkSrcBook.Sheets(1).Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)

如何调整此vba代码以仅从第一个工作表中复制

1 个答案: