Run Time Error 9...

[HelloLloyd]

I keep getting "Run-time error '9': Subscript out of range." I am trying to make the code let me copy and paste a series of ranges without having to manually input the ranges and worksheets for each copy and paste operation. To try and clarify, I have 7 different worksheets that I need to get 12 ranges off of each. I want to be able to use the same set of 12 copy lines on all 7 sheets instead of having to code 84 lines of code to copy them. I hope someone can make heads or tails of this. Here is a copy of what I have....


Public SavePath As String
Public File As String


Sub Main()
Call Save_File
Call Open_File
Call Copy_Data
End Sub

Sub Save_File()
SavePath = InputBox("Save File As:&quot
ActiveWorkbook.SaveAs Filename:=SavePath, FileFormat:=xlWorkbookNormal
End Sub

Sub Open_File()
'Prompts the user for the file name of the file containing the data to input
Path = InputBox("Please input the file and path name of the data file:", "Open File&quot
'Opens the file the user specified
Application.Workbooks.Open Filename:=Path
Call Activate_File(Path)
End Sub

Sub Activate_File(Path)
File = ExtractFile(Path)
Application.Workbooks(File).Activate
Application.Worksheets("Lot 1&quot.Activate
End Sub

Function ExtractFile(Path)
Position = InStrRev(Path, "\&quot
ExtractFile = Right$(Path, Len(Path) - Position)
End Function

Sub Copy_Data()
Counter = 0
SaveName = ExtractFile(SavePath)
For Each Sheet In Workbooks
If Sheet.Name = ActiveWorkbook.Name Then
Select Case Counter
Case 1
Name = "Lot 1 Data"
MsgBox Name
Case 2
Name = "Lot 2 Data"
MsgBox Name
Case 3
Name = "Lot 3 Data"
MsgBox Name
Case 4
Name = "Lot 5 Data"
MsgBox Name
Case 5
Name = "Lot 6 Data"
MsgBox Name
Case 6
Name = "Lot 7 Data"
MsgBox Name
Case 7
Name = "Lot 8 Data"
MsgBox Name
End Select
ActiveSheet.Range("g14:db14&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c2:az2&quot
ActiveSheet.Range("g33:db33&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c3:az3&quot
ActiveSheet.Range("g52:db52&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c4:az4&quot
ActiveSheet.Range("g71:db71&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c5:az5&quot
ActiveSheet.Range("g90:db90&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c6:az6&quot
ActiveSheet.Range("g109:db109&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c7:az7&quot
ActiveSheet.Range("g128:db128&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c8:az8&quot
ActiveSheet.Range("g147:db147&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c9:az9&quot
ActiveSheet.Range("g166:db166&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c10:az10&quot
ActiveSheet.Range("g185:db185&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c11:az11&quot
ActiveSheet.Range("g204:db204&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c12:az12&quot
ActiveSheet.Range("g223:db223&quot.Copy Application.Workbooks(SaveName).Worksheets(Name).Range("c13:az13&quot
Counter = Counter + 1
Else
Application.Workbooks(File).Activate
If Sheet.Name = ActiveWorkbook.Name Then
Counter = Counter + 1
End If
End If
Next Sheet
End Sub

 

[HelloLloyd]

Okay. I answered my own stupid question. I hadn't set counter to 1 BEFORE it went to the case statement. After doing that it works, but it doesn't loop through all the worksheets in the active workbook. It goes through the case and if statements once. I need it to go through as many times as there are worksheets. I know that I can just put it all in an if loop that increments up to the number of worksheets I have, but I would like for it to be more flexible and not require recoding if I add another worksheet to the workbook. In short, I don't want to fix the loop at 7. I want it to calculate how many times to loop. That's what I thought the For Each-Next would do. Please help me with my logic. Thanks again.