PDA

View Full Version : VBA Excel Help Selecting Multiple Pages



brettreinhar
01-30-2014, 04:03 PM
Hello all,

I have been writing a code for a couple days and have run into a problem. This is one of my first few codes ever being written so bare with me on some of the improper "code".


Sub TabsandFormulaReplacement()
Sheets("Attendance Jan-Jun").Select
Words = Cells.Range("B3:B67")
For Each Item In Words
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Item
Next Item

Sheets("Register").Select
Range("A11:B11").Select
Selection.AutoFill Destination:=Range("A11:B80"), Type:=xlFillDefault
Range("A11:B80").Select
Range("AE11").Select
Selection.AutoFill Destination:=Range("AE11:AE80"), Type:=xlFillDefault
Range("AE11:AE80").Select


Sheets("Formula Replacement").Select
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A70"), Type:=xlFillDefault
Range("A2:A70").Select
Range("AL2:BM70").Select
Range("BM70").Activate
Selection.Copy


Sheets("Register").Select
Range("C11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False
Cells.Replace What:=" =", Replacement:="=", LookAt:=xlPart, SearchOrder :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False


Sheets("Formula Replacement").Select
Range("BU2:BX70").Select
Range("BX70").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sign-Up Dates YTD").Select
ActiveWindow.SmallScroll Down:=-36
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False
Cells.Replace What:=" =", Replacement:="=", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveWindow.SmallScroll Down:=45
Range("A3:B3").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A3:B70"), Type:=xlFillDefault
Range("A3:B70").Select


Sheets("Template").Select
Cells.Select
Selection.Copy
Sheets(Array("Alba", "Assadourian", "Azrialy", "BassGalespie", "Boden", "Briseno", "Bruyninx", "Buckler", "Burlingame", "Cano", "Chaudhry", "Cloma", "Colomby", "David", _
"Elias", "Escamilla", "Fairbanks", "Gonzalez", "Guertin", "Hadlock", "Hall", "Halsey", "Hayes", "Hirsch", "Hughes")).Select
Sheets("Alba").Activate
Sheets(Array("Kirkbride", "Lang", "LaRaia", "Law", "Ledwith", "Lopez", "Lovullo", "Kamio", "MayfieldChong", "Melvin", "Miller", "Mitchell", "Montgomery", "Morena", _
"Motzkin", "Murphy", "Nuila", "Olea", "Paxton", "Pierson", "Ramirez", "Salmones", "Sanchez", "Scoggins", "Sepulveda")).Select Replace:=False
Sheets(Array("Shigekawa", "Smith", "Speak", "Stilo", "Taylor", "Tibbs", "VanMetter", "Villegas", "Walsh", "Warburton", "Ward", "WhiteHeard", "Zimring")).Select Replace:=False
ActiveWindow.SmallScroll Down:=-12
Range("A1").Select
ActiveSheet.Paste
Range("D2").Select
ActiveCell.FormulaR1C1 = "1/27/2014"

End Sub




The bold is where I am having trouble. I currently have them manually entered into vba, what I need is a easier way.
The names of the sheet are originally made from the sheet
"Attendance Jan-Jun" in cells B3:B67.

Thank you for any help you can provide.

here is the code in PHP


Sub TabsandFormulaReplacement()
Sheets("Attendance Jan-Jun").Select
Words = Cells.Range("B3:B67")
For Each Item In Words
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Item
Next Item

Sheets("Register").Select
Range("A11:B11").Select
Selection.AutoFill Destination:=Range("A11:B80"), Type:=xlFillDefault
Range("A11:B80").Select
Range("AE11").Select
Selection.AutoFill Destination:=Range("AE11:AE80"), Type:=xlFillDefault
Range("AE11:AE80").Select


Sheets("Formula Replacement").Select
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A70"), Type:=xlFillDefault
Range("A2:A70").Select
Range("AL2:BM70").Select
Range("BM70").Activate
Selection.Copy


Sheets("Register").Select
Range("C11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Replace What:=" =", Replacement:="=", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False


Sheets("Formula Replacement").Select
Range("BU2:BX70").Select
Range("BX70").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sign-Up Dates YTD").Select
ActiveWindow.SmallScroll Down:=-36
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Replace What:=" =", Replacement:="=", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveWindow.SmallScroll Down:=45
Range("A3:B3").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A3:B70"), Type:=xlFillDefault
Range("A3:B70").Select


Sheets("Template").Select
Cells.Select
Selection.Copy
Sheets(Array("Alba", "Assadourian", "Azrialy", "BassGalespie", "Boden", "Briseno", _
"Bruyninx", "Buckler", "Burlingame", "Cano", "Chaudhry", "Cloma", "Colomby", "David", _
"Elias", "Escamilla", "Fairbanks", "Gonzalez", "Guertin", "Hadlock", "Hall", "Halsey", _
"Hayes", "Hirsch", "Hughes")).Select
Sheets("Alba").Activate
Sheets(Array("Kirkbride", "Lang", "LaRaia", "Law", "Ledwith", "Lopez", "Lovullo", _
"Kamio", "MayfieldChong", "Melvin", "Miller", "Mitchell", "Montgomery", "Morena", _
"Motzkin", "Murphy", "Nuila", "Olea", "Paxton", "Pierson", "Ramirez", "Salmones", _
"Sanchez", "Scoggins", "Sepulveda")).Select Replace:=False
Sheets(Array("Shigekawa", "Smith", "Speak", "Stilo", "Taylor", "Tibbs", "VanMetter", "Villegas", _
"Walsh", "Warburton", "Ward", "WhiteHeard", "Zimring")).Select Replace:=False
ActiveWindow.SmallScroll Down:=-12
Range("A1").Select
ActiveSheet.Paste
Range("D2").Select
ActiveCell.FormulaR1C1 = "1/27/2014"



End Sub

Bob Phillips
01-30-2014, 04:52 PM
Dim cell As Range
With Worksheets("Attendance Jan-Jun")

Worksheets(.Range("B3").Value).Select
For Each cell In .Range("B4:B67")

If cell.Value <> "" Then Worksheets(cell.Value).Select Replace:=False
Next cell
End With
Range("D12").Select
ActiveSheet.Paste
Range("D2").FormulaR1C1 = "1/27/2014"