-2

I have an excel with multiple sheets. I have created a macro on one sheet with the macro code below. How can i edit this code to be applied on all sheets in the workbook in one run. Thank you

Sub scoresheet() ' ' scoresheet Macro '

'

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

  • 2
    You need to google loop through worksheets in vba. – Nathan_Sav Nov 30 '16 at 14:31
  • Can you show me how is that ? i am not a developer. Thank you – Tarek Khedr Nov 30 '16 at 14:34
  • 2
    Wow, that recorder code is verbose...clean it up some with http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros – Rdster Nov 30 '16 at 14:35
  • 2
    Luckily, you don't have to be a developer to be able to Google. – Rdster Nov 30 '16 at 14:40
  • @Rdster : I think the reason that i asked the question here is that i the results i found on "google" were complicated to me. Thanks for your info " Luckily, you don't have to be a developer to be able to Google" – Tarek Khedr Nov 30 '16 at 15:07
  • @TarekKhedr Seriously??? https://support.microsoft.com/en-us/kb/142126 was the very first hit on Google after searching for "Excel VBA loop through all worksheets". Looks almost exactly the same as the answer below. Not very complicated at all. – Rdster Nov 30 '16 at 15:10
  • Give me a break Mr VBA developer, I have tried that code and i can't get it running, i don't know why. If you don't want to help then thank you and there is no need for such a comments. @Rdster – Tarek Khedr Nov 30 '16 at 15:13
  • That would have been a great thing to include in your original post. And if you can't get it running, why accept it as the answer???? – Rdster Nov 30 '16 at 15:17

2 Answers2

1

You could use something like this to loop through your worksheets. As an example, this macro just activates each sheet and shows a message box with the name, but you just need to copy paste what code you want to run on each sheet in its place. And just to reiterate what @Rdster has said, you might want to invest some time in organising your code better as it is very clunky :)

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
0

Edit this to fit your needs:

 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
Graham
  • 7,431
  • 18
  • 59
  • 84
Doug Coats
  • 6,255
  • 9
  • 27
  • 49