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

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

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

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