このVBAを現在のワークブックのすべてのワークシートにループさせようとしています。

Question

このループ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 

懸念される2つの領域。まず、記入したときに正しく変更されない行と列の絶対参照を使用して数式を設計したと思います。計算された値に戻す前に、式を確認する必要があります。第二に、.Range("A12").Delete Shift:=xlUpが外れているように見え、そのアクションはワークシートを改善するものではないようです。あなたはそれを調べなければなりません。