Vba To Run Macro On List Of Worksheets 1

[ADE6]

Hi,

I have a macro called "TRIAL" shown at the bottom of this post, the macro executes the section of code shown below THREE times when running(SHOWN IN RED)

Dim strSheet As String 
strSheet =  Sheets("CONTROL PANEL"). Range("A1").Value 
Sheets(strSheet).Select 'Sheets("BRENT CRUDE").Select

Cell A1 in the "CONTROL PANEL" sheet refers to the first in a list of worksheets listed in column A.

I would like the macro to run using the value shown in cell A1 then loop and run again substituting A2 for A1 in ALL three instances of the code above and then move down to the next row A3 and run the macro again until all worksheets shown in column A of the "CONTROL PANEL " sheet have been recalculated.

Thanks for the ideas.

Ade

Sub TRIAL() 
 '
     ' TRIAL Macro
     ' Macro recorded 09/05/2007 by  ADE
 '
     
 '
    Application. ScreenUpdating = False 
    [COLOR=RED]Dim strSheet As String 
    strSheet = Sheets("CONTROL PANEL").Range("A1").Value 
    Sheets(strSheet).Select 'Sheets("BRENT CRUDE").Select[/COLOR]
    Range("AZ3:BA660").Select 
    Selection.Copy 
    Range("DA3").Select 
    Selection.PasteSpecial PASTE:=xlPasteValuesAndNumberFormats, Operation:= _ 
    xlNone, SkipBlanks:=False, Transpose:=False 
    Range("FG32420:GP32459").Select 
    Selection.Copy 
    Range("FH32420").Select 
    Selection.PasteSpecial PASTE:=xlPasteValuesAndNumberFormats, Operation:= _ 
    xlNone, SkipBlanks:=False, Transpose:=False 
    Range("GQ32420:GQ32459").Select 
    Selection.ClearContents 
    Range("FG32420:FG32459").Select 
    Selection.ClearContents 
    Range("BB10001:CH12000").Select 
    Selection.Copy 
    Sheets("PASTE LINKS").Select 
    Range("BB20002").Select 
    Selection.PasteSpecial PASTE:=xlPasteValuesAndNumberFormats, Operation:= _ 
    xlNone, SkipBlanks:=False, Transpose:=False 
    Range("BB20002:CH24000").Select 
    Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder _ 
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 
    Range("BB20002:BF22000").Select 
    Selection.Sort Key1:=Range("BB20002"), Order1:=xlDescending,  Header:=xlGuess _ 
    , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 
    Range("BI20002:BM22000").Select 
    Selection.Sort Key1:=Range("BI20002"), Order1:=xlDescending, Header:=xlGuess _ 
    , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 
    Range("BP20002:BT22000").Select 
    Selection.Sort Key1:=Range("BP20002"), Order1:=xlDescending, Header:=xlGuess _ 
    , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 
    Range("BW20002:CA22000").Select 
    Selection.Sort Key1:=Range("BW20002"), Order1:=xlDescending, Header:=xlGuess _ 
    , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 
    Range("CD20002:CH22000").Select 
    Selection.Sort Key1:=Range("CD20002"), Order1:=xlDescending, Header:=xlGuess _ 
    , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 
    Range("BB20002:CH22000").Select 
    Selection.Copy 
    Range("AC4").Select 
    Selection.PasteSpecial PASTE:=xlPasteValuesAndNumberFormats, Operation:= _ 
    xlNone, SkipBlanks:=False, Transpose:=False 
    Sheets("CALC").Select 
    SolverOk SetCell:="$F$21", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$21" 
    SolverSolve UserFinish:=True 
    SolverOk SetCell:="$F$54", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$54" 
    SolverSolve UserFinish:=True 
    SolverOk SetCell:="$F$87", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$87" 
    SolverSolve UserFinish:=True 
    SolverOk SetCell:="$F$120", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$120" 
    SolverSolve UserFinish:=True 
    Range("AT5:AU86").Select 
    Selection.Copy 
    Range("AW5").Select 
    ActiveSheet.PasteSpecial  Format:=3, Link:=1, DisplayAsIcon:=False, _ 
    IconFileName:=False 
    Range("AT5:AX86").Select 
    Selection.Copy 
    Range("AW5").Select 
    ActiveSheet.PasteSpecial Format:=4, Link:=1, DisplayAsIcon:=False, _ 
    IconFileName:=False 
    Range("AW5:AX86").Select 
    Selection.Sort Key1:=Range("AX5"), Order1:=xlDescending, Header:=xlGuess _ 
    , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 
    Range("AW5:AX45").Select 
    Selection.Copy 
    Range("AM4").Select 
    Selection.PasteSpecial PASTE:=xlPasteAllExceptBorders, Operation:=xlNone, _ 
    SkipBlanks:=False, Transpose:=False 
    Range("AW46:AX86").Select 
    Selection.Copy 
    Range("AJ4").Select 
    Selection.PasteSpecial PASTE:=xlPasteAllExceptBorders, Operation:=xlNone, _ 
    SkipBlanks:=False, Transpose:=False 
    Range("M1:CH56").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("CONTROL PANEL").Select 
    [COLOR=RED]strSheet = Sheets("CONTROL PANEL").Range("A1").Value 
    Sheets(strSheet).Select 'Sheets("BRENT CRUDE").Select[/COLOR ]
    Range("M1").Select 
    Selection.PasteSpecial PASTE:=xlPasteValuesAndNumberFormats, Operation:= _ 
    xlNone, SkipBlanks:=False, Transpose:=False 
    Range("FD32420:FD32459").Select 
    Selection.Copy 
    Range("FG32420").Select 
    Selection.PasteSpecial PASTE:=xlPasteValuesAndNumberFormats, Operation:= _ 
    xlNone, SkipBlanks:=False, Transpose:=False 
    Range("DA3:DB660").Select 
    Selection.Copy 
    Range("AZ4").Select 
    Selection.PasteSpecial PASTE:=xlPasteValuesAndNumberFormats, Operation:= _ 
    xlNone, SkipBlanks:=False, Transpose:=False 
    Sheets("CALC").Select 
    Range("AJ4:AN44").Select 
    Selection.Copy 
    Sheets("CONTROL PANEL").Select 
    [COLOR=RED]strSheet = Sheets("CONTROL PANEL").Range("A1").Value 
    Sheets(strSheet).Select 'Sheets("BRENT CRUDE").Select[/COLOR]
    Range("AJ4").Select 
    Selection.PasteSpecial PASTE:=xlPasteAllExceptBorders, Operation:=xlNone, _ 
    SkipBlanks:=False, Transpose:=False 
    Range("AI4").Select 
    Application.ScreenUpdating = True 
    Sheets("WATCH LIST").Select 
    Range("A1").Select 
     
     
     
End Sub

 

[SkipVought]

Hi,

Something like this. but I can't figure out what you are doing...

    Dim r As Range
    
    For Each r In Sheets("CONTROL PANEL").Range(Sheets("CONTROL PANEL").[A1], Sheets("CONTROL PANEL").[A1].End(xlDown))
        With Sheets(r.Value)
            .Range("AZ3:BA660").Copy
            .Range("DA3").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
            
            .Range("FG32420:GP32459").Copy
            .Range("FH32420").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
            
            .Range("GQ32420:GQ32459").ClearContents
            .Range("FG32420:FG32459").ClearContents
 '.......           
        End With
    Next

Skip,
[sub]
[red][/red]
[/sub]