试图让这个 vba 循环遍历当前工作簿中的所有工作表。它贯穿第一

Trying to get this vba to loop through all worksheets in the current workbook. It runs through the first

此循环 VBA 脚本在完成活动工作簿中的第一个工作表后停止,但需要它循环遍历所有工作表。有人可以帮助我理解我缺少什么让循环连续移动通过所有工作表吗?

Sub forEachws()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
  Call Music_Connect_Albums(ws)
  Next
End Sub

Sub Music_Connect_Albums(ws As Worksheet)
    With ws
    .Columns("B:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("A13").Select
    ActiveCell.FormulaR1C1 = "Artist"
    .Range("B13").Select
    ActiveCell.FormulaR1C1 = "Title"
    .Range("C13").Select
    ActiveCell.FormulaR1C1 = "Release"
    .Range("D13").Select
    ActiveCell.FormulaR1C1 = "Label"
    .Range("E13").Select
    ActiveCell.FormulaR1C1 = "Age"
    .Range("F13").Select
    ActiveCell.FormulaR1C1 = "Yr"
    .Range("G13").Select
    ActiveCell.FormulaR1C1 = "Wk"
    .Range("H13").Select
    ActiveCell.FormulaR1C1 = "Wk-End"
    .Range("A14").Select
    ActiveCell.FormulaR1C1 = "=R2C10"
    .Range("B14").Select
    ActiveCell.FormulaR1C1 = "=R3C10"
    .Range("C14").Select
    ActiveCell.FormulaR1C1 = "=R4C10"
    .Range("D14").Select
    ActiveCell.FormulaR1C1 = "=R5C10"
    .Range("E14").Select
    ActiveCell.FormulaR1C1 = "=R9C10"
    .Range("F14").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(R8C10,4)"
    .Range("G14").Select
    ActiveCell.FormulaR1C1 = "=MID(R13C10,6,2)"
    .Range("G14").Select
    ActiveCell.FormulaR1C1 = "=MID(R13C13,6,2)"
    .Range("H14").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(R8C10,10)"
    .Range("A14:H14").Select
    Selection.AutoFill Destination:=Range("A14:H35")
    .Range("A14:H35").Select
    .Columns("A:H").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Rows("1:13").Select
    .Range("A12").Activate
    .Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    .Columns("I").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
End Sub

这里是在没有 .Select 或 .Activate 的情况下快速重写的代码。

Option Explicit

Sub forEachws()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        Call Music_Connect_Albums(ws)
    Next
End Sub

Sub Music_Connect_Albums(ws As Worksheet)
    With ws
        .Columns("B:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("A13:H13").Value = Array("Artist", "Title", "Release", "Label", _
                                        "Age", "Yr", "Wk", "Wk-End")
        .Range("A14:H14").FormulaR1C1 = Array("=R2C10", "=R3C10", "=R4C10", "=R5C10", "=R9C10", _
                                               "=RIGHT(R8C10,4)", "=MID(R13C10,6,2)", "=MID(R13C13,6,2)", _
                                               "=RIGHT(R8C10,10)")
        With .Range("A14:H35")
            .FillDown
            'uncomment the next line after you have examined the formulas
            '.Value = .Value
        End With
        .Range("A12").Delete Shift:=xlUp
        On Error Resume Next
        .Columns("I").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
    End With
End Sub

两个值得关注的领域。首先,我相信您在设计公式时使用了绝对行和列引用,这些引用在填充时不会正确更改。在恢复为计算值之前,您应该查看这些公式。其次,.Range("A12").Delete Shift:=xlUp 似乎不合适,并且该操作似乎没有做一些改进工作表的事情;你应该调查一下。