Hi there,
I'm trying to solve a problem where I have one excel workbook with ~100 sheets which contain information pertaining to different people. Their names are stored in cell B6. I want to copy all of the sheets that refer to each person into a separate workbook, and keep the master workbook the same.
I've made small modifications to a similar code, but keep getting a "subscript out of range" error. The other problem referred to a range of cells, instead of just one, so possibly that's the problem. As a beginner to VBA, I really need some guidance, and would appreciate any sort of help!
Here's what I currently have:
Code
Sub moveSheets()
Dim myArray() As String
Dim myRange As Range
Dim Cell As Range
Dim OldBook As String
Dim newBook As String
Dim a As Long
Set myRange = Sheets("Page1_1").Range("B6")
OldBook = ActiveWorkbook.Name
For Each Cell In myRange
If Not Cell = "" Then
a = a + 1
ReDim Preserve myArray(1 To a)
myArray(a) = Cell
End If
Next
For a = 1 To UBound(myArray)
If a = 1 Then
Sheets(myArray(a)).Copy
newBook = ActiveWorkbook.Name
Workbooks(OldBook).Activate
Else
Sheets(myArray(a)).Copy After:=Workbooks(newBook).Sheets(a - 1)
Workbooks(OldBook).Activate
End If
Next
End Sub
Display More