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

在完成活动工作簿中的第一个工作表后，此循环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 

Answer 1

这里是没有.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 

两个关注领域。 首先，我相信你devise了绝对的行和列引用的公式，在填充时不能正确更改。 在恢复到计算值之前，您应该查看公式。 其次， .Range("A12").Delete Shift:=xlUp看起来.Range("A12").Delete Shift:=xlUp ，并且这个动作似乎没有改进工作表。 你应该看看。