Question

我似乎无法让代码循环到下一个工作簿打开。之后，我想将每个工作簿中的所有单个工作表合并到一个工作簿中，并根据它的工作簿名称重命名每个选项卡。

我不是太远但是第一句话是我的第一个任务

  Sub cullworkbooksandCONSOLIDATE()
        Dim ws As Worksheet
        Dim wb As Workbook
        Dim wsNAME As String

            For Each wb In Application.Workbooks

            With wb
                For Each ws In ActiveWorkbook.Worksheets

                    With ws
                        wsNAME = ws.Name
                        If wsNAME <> "summary details" Then
                            ws.Delete
                        End If

                    End With

                Next
            End With
            Next


    End Sub

谢天谢地

Answer 1

或者更直接地，只需复制工作表（如果存在），而不是删除所有不匹配（如果代码删除所有工作表，也会导致错误）

Sub cullworkbooksandCONSOLIDATE()

Dim wb As Workbook
Dim wb1 As Workbook
Dim ws As Worksheet
Dim wsNAME As String


Set wb1 = Workbooks.Add(1)
wsNAME = "summary details"


For Each wb In Application.Workbooks
    With wb
        If .Name <> wb1.Name Then 'if it's not the export workbook
            On Error Resume Next
            Set ws = wb.Sheets(wsNAME)
            On Error GoTo 0
            If Not ws Is Nothing Then ws.Copy Before:=wb1.Sheets(1)
        End If
    End With
Next
End Sub

Answer 2

这不是我的简历。

Sub cullworkbooksandCONSOLIDATE()
      Dim ws As Worksheet
      Dim wb As Workbook
      Dim wsNAME As String
      Dim wbex As Workbook
'You'll need to define wbex, this is where your worksheets will be inserted
For Each wb In Application.Workbooks
    With wb
        If .Name <> wbex.Name Then 'if it's not the export workbook
                For Each ws In wb.Worksheets 'not necessarily active workbook
                    With ws
                        wsNAME = LCase(.Name)
                        If wsNAME <> "summary details" Then
                            .Delete 'why do you need to delete it?
                        Else
                            .Name = wb.Name
                            .Copy Before:=wbex.Sheets(1)
                        End If
                    End With
                Next
            .Close SaveChanges:=False 'you really don't want to corrupt your source data, do you?
        End If
    End With
Next
End Sub

VBA删除所有不等于“摘要详细信息”的工作簿中的所有工作表

2 个答案: