すべてのシートに適用するマクロをExcel

-2

私は複数のシートで優れています。以下のマクロコードで1枚のシートにマクロを作成しました。このコードを編集してブック内のすべてのシートに一度に適用するにはどうすればよいですか。これはあなたのニーズに合わせて、あなたがすべてのシートに適用するマクロをExcel

サブスコアシート（） ' ' マクロ '

ActiveWindow.ScrollColumn = 6 
ActiveWindow.ScrollColumn = 5 
ActiveWindow.ScrollColumn = 4 
ActiveWindow.ScrollColumn = 3 
ActiveWindow.ScrollColumn = 2 
ActiveWindow.ScrollColumn = 1 
Columns("F:F").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("E:E").Select 
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ 
    :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 
Columns("I:I").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("H:H").Select 
Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ 
    :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True 
Range("I1").Select 
ActiveCell.FormulaR1C1 = "3fga " 
With ActiveCell.Characters(Start:=1, Length:=5).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Columns("L:L").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("K:K").Select 
Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ 
    :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True 
Columns("Y:AB").Select 
Selection.Delete Shift:=xlToLeft 
Columns("Z:Z").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("Y:Y").Select 
Selection.TextToColumns Destination:=Range("Y1"), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ 
    :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True 
Range("Y1").Select 
ActiveCell.FormulaR1C1 = "op_fgm" 
With ActiveCell.Characters(Start:=1, Length:=6).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Range("Z1").Select 
ActiveCell.FormulaR1C1 = "op_fga " 
With ActiveCell.Characters(Start:=1, Length:=7).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Columns("AA:AA").Select 
Selection.Delete Shift:=xlToLeft 
Columns("AB:AB").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("AA:AA").Select 
Selection.TextToColumns Destination:=Range("AA1"), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ 
    :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True 
Range("AA1").Select 
ActiveCell.FormulaR1C1 = "op_3fg" 
With ActiveCell.Characters(Start:=1, Length:=6).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Range("AB1").Select 
ActiveCell.FormulaR1C1 = "op_3fga " 
With ActiveCell.Characters(Start:=1, Length:=8).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Columns("AC:AC").Select 
Selection.Delete Shift:=xlToLeft 
Columns("AD:AD").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("AC:AC").Select 
Selection.TextToColumns Destination:=Range("AC1"), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ 
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ 
    :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True 
Range("AC1").Select 
ActiveCell.FormulaR1C1 = "op_ftm" 
With ActiveCell.Characters(Start:=1, Length:=6).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Range("AD1").Select 
ActiveCell.FormulaR1C1 = "op_fta " 
With ActiveCell.Characters(Start:=1, Length:=7).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Columns("AE:AE").Select 
Selection.Delete Shift:=xlToLeft 
Range("AE1").Select 
ActiveCell.FormulaR1C1 = "op_off " 
With ActiveCell.Characters(Start:=1, Length:=7).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Range("AF1").Select 
ActiveCell.FormulaR1C1 = "op_def " 
With ActiveCell.Characters(Start:=1, Length:=7).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Columns("AG:AH").Select 
Selection.Delete Shift:=xlToLeft 
Range("AG1").Select 
ActiveCell.FormulaR1C1 = "op_pf " 
With ActiveCell.Characters(Start:=1, Length:=6).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Range("AH1").Select 
ActiveCell.FormulaR1C1 = "op_ast " 
With ActiveCell.Characters(Start:=1, Length:=7).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Range("AI1").Select 
ActiveCell.FormulaR1C1 = "op_to " 
With ActiveCell.Characters(Start:=1, Length:=6).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Range("AJ1").Select 
ActiveCell.FormulaR1C1 = "op_blk " 
With ActiveCell.Characters(Start:=1, Length:=7).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Range("AK1").Select 
ActiveCell.FormulaR1C1 = "op_stl " 
With ActiveCell.Characters(Start:=1, Length:=7).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Columns("AL:AM").Select 
Selection.Delete Shift:=xlToLeft 
Range("T1").Select 
ActiveCell.FormulaR1C1 = "to " 
With ActiveCell.Characters(Start:=1, Length:=3).Font 
    .Name = "Verdana" 
    .FontStyle = "Bold" 
    .Size = 7.5 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .Color = -1 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontNone 
End With 
Rows("1:1").Select 
Range("P1").Activate 
With Selection.Font 
    .ThemeColor = xlThemeColorDark1 
    .TintAndShade = 0 
End With 
Range("X1").Select

End Subの

出典

2016-11-30 Tarek Khedr

あなたはVBAでのワークシートをループをグーグルする必要があります。 –

あなたは私にそれを見せてもらえますか？私は開発者ではない。ありがとうございます –

うわー、そのレコーダーコードは冗長です... http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros – Rdster

次のようなものを使うことができますこれはワークシートをループします。例として、このマクロは各シートをアクティブにして名前付きのメッセージボックスを表示しますが、各シート上で実行するコードをコピーしてコピーするだけで済みます。そして、ちょうど@Rdsterが言ったことを繰り返すために、あなたはそれが非常に不格好であるとして、より良いあなたのコードを整理するには、いくつかの時間を投資することをお勧めします:)

Sub WorksheetLoop() 

Dim Count1 As Integer 
Dim i As Integer 

'Set Count1 equal to the number of worksheets in the active workbook. 

Count1 = ActiveWorkbook.Worksheets.Count 

For i = 1 To Count1 

    Worksheets(i).Activate 

    MsgBox ActiveWorkbook.Worksheets(i).Name 

Next 

End Sub

出典

2016-11-30 14:39:36

ありがとうございます、私はこれを試してみます –

シートを活性化することは不必要で厄介です。たくさんのシートがある場合はどうなりますか？彼のスクリプトが永遠に動くようにしたいですか？ lol –

私はちょうど例としてそれを取り入れて作業しました。あなたが望むものを含める;） –

編集をスコアシートありがとう：

Sub Theloopofloops() 

Dim wbk As Workbook 
Dim Filename As String 
Dim path As String 
Dim rCell As Range 
Dim rRng As Range 
Dim wsO As Worksheet 
Dim sheet As Worksheet 


path = "pathtofile(s)" & "\" 
Filename = Dir(path & "*.xl??") 
Set wsO = ThisWorkbook.Sheets("Sheet1") 'included in case you need to differentiate_ 
       between workbooks i.e currently opened workbook vs workbook containing code 

Do While Len(Filename) > 0 
    DoEvents 
    Set wbk = Workbooks.Open(path & Filename, True, True) 
     For Each sheet In ActiveWorkbook.Worksheets 'this needs to be adjusted for specifiying sheets. Repeat loop for each sheet so thats on a per sheet basis 
       Set rRng = sheet.Range("a1:a1000") 'OBV needs to be changed 
       For Each rCell In rRng.Cells 
       If rCell <> "" And rCell.Value <> vbNullString And rCell.Value <> 0 Then 

        'code that does stuff 

       End If 
       Next rCell 
     Next sheet 
    wbk.Close False 
    Filename = Dir 
Loop 
End Sub

出典

2016-11-30 14:39:35

すべてのシートに適用するマクロをExcel

答えて

関連する問題