Question

我有一个由100多个工作表组成的工作簿。这些工作表在工作表的名称中有帐号/名称/天。

工作表的命名约定遵循AccountNumber / AccountName / Description：

的这种模式

11-Greg-Monday
11-Greg-Tuesday
11-Greg-Friday
38-Rachel-Sunday
38-Rachel-Tuesday
38-Rachel-Saturday

我希望Excel循环遍历所有工作表，并提取所有11-Greg工作表并保存到名为11-Greg的新工作簿中，然后对38-Rachel等执行相同操作。我有一个列表名为＆＃34; Accounts＆＃34;的工作表中的帐号/姓名在工作簿中。

是否可以在工作表的提取之后维护公式，并像列宽一样格式化？

我发现这段代码可能有用，但我不知道如何引用＆＃34; Accounts＆＃34;用于循环查看帐户名称的标签？

Dim wb as Workbook, sht as WorkSheet
Dim strFileName As String

'Copy sheet as a new workbook
ActiveWorkbook.Sheets("Sheet1").Copy

Set wb = ActiveWorkbook
Set sht = wb.Sheets(1)

'SaveAs
strFileName = Application.GetSaveAsFilename(wb.Name) & "xlsx"
If strFileName = "False" Then Exit Sub 'User Canceled
wb.SaveAs Filename:=strFileName

Answer 1

最简单的方法是在单独的列表中创建要堆叠的名称列表。将该列表设置为范围，然后遍历每个单元格以检查工作表名称的x个字母是否匹配。像这样的东西

   Sub stacksheets()
Dim rng As Range, cCell As Range
Dim ws As Worksheet
Dim wb As Workbook, wb2 As Workbook
Dim shName As String

Set rng = ActiveWorkbook.Sheets("list").Range("a1:a2") ''this would be the list of names
Set wb2 = ActiveWorkbook ''remembering activeworkbook so can return


For Each cCell In rng
    shName = Left(cCell.Value, 5) ''this needs to be the minimum letters from each name that is unique
    Set wb = Workbooks.Add

    For Each ws In wb2.Sheets
        If InStr(ws.Name, shName) > 0 Then ''checks for name in sheet name
            ws.Copy after:=wb.Sheets(1)
            wb2.Activate
        End If
    Next ws
    wb.SaveAs (wb2.Path & "\" & cCell.Value) '' saves workbook as list name

Next cCell

End Sub

将工作表结合到基于标准和保存的新工作簿中

1 个答案: