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

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