Question

您好，我是VBA的新用户，我想使用VBA在excel中复制第一张纸。这是我的代码。我一直在获取所有工作簿的所有工作表。我该怎么办？

Sub Consolidator()

    Dim Path            As String
    Dim FileName        As String
    Dim Wkb             As Workbook
    Dim ws              As Worksheet
    Dim diaFolder       As FileDialog

    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
          diaFolder.AllowMultiSelect = False
        diaFolder.Show

    fle = diaFolder.SelectedItems(1)


    Application.EnableEvents = False
    Application.ScreenUpdating = False
       Path = fle
       FileName = Dir(Path & "\*.xls", vbNormal)

    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each ws In Wkb.Worksheets


        ws.Copy Before:=Workbooks(Consolidate)

            ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Next ws

        Wkb.Close False
        FileName = Dir()
    Loop

    Application.EnableEvents = True
    Application.ScreenUpdating = True

Set diaFolder = Nothing

End Sub

Answer 1

更改：

   Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each ws In Wkb.Worksheets


        ws.Copy Before:=Workbooks(Consolidate)

            ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Next ws

        Wkb.Close False
        FileName = Dir()
    Loop

收件人：

       Dim Wb1 as workbook: Set Wb1 = thisworkbook

       Do Until FileName = ""
            Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
            Wkb.sheets(1).Copy After:=Wb1.sheets(Wb1.sheets.count)
            Wkb.Close False
            FileName = Dir()
        Loop

Answer 2

您的For Each ws in Wkb.Worksheets...Next ws将遍历工作簿的Worksheets集合中的每个工作表，即，如您所描述的，将复制工作簿中的每个工作表。

仅执行第一个工作表，您需要删除For Each...Next循环，并将其替换为：

Wkb.Worksheets(1).Copy Before:=Workbooks(Consolidate)
Wkb.Worksheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

在这种情况下，Wkb.Worksheets(1)返回当前工作簿Wkb中的第一个工作表

如何仅复制VBA Excel中的第一个工作表

2 个答案: