0

Basically, I have a column worth of names that I need to go through and use to create a new workbook, with each worksheet name being from the column. I am having trouble with the copy over. Here is my code:

Sub copySheet()
Dim oldBook As String
Dim newBook As String
Dim myRange As Range

Set myRange = Sheets("TOC").Range("O5:O381")

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 2
    If a = 1 Then
        myArray(a).Copy
        newBook = ActiveWorkbook.name
        Workbooks(oldBook).Activate
    Else
        myArray(a).Copy After:=Workbooks(newBook).Sheets(a - 1)
End Sub
  • I didn't read your code in full, so I might be wrong. But for adding sheets try `Sheets.Add` (see [here](https://stackoverflow.com/a/3840728/1726522)). Also, you are refering both oldBook and newBook as `ActiveWorkbook`: something is wrong. If code is in old workbook use `oldBook =Thisworkbook.name` and for the new one hard code the name, or create it depending on your needs. – CMArg Jun 13 '17 at 16:40

1 Answers1

1

You can do this using just the one loop.

' Creates a blank page in a new book,
' named after the contents of cells A1:A3
' in Sheet1 of the current workbook.
Sub CreateNewWorkbook()

    Dim cell As Range           ' Used to loop over cells.
    Dim nwb As Workbook         ' Used to create new workbook.
    Dim nws As Worksheet        ' Used to create sheets.

    ' Create new workbook.
    Set nwb = Application.Workbooks.Add

    ' Add a new worksheet for each cell in the range.
    For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A1:A3").Cells

        Set nws = nwb.Sheets.Add
        nws.Name = cell.Value
    Next
End Sub

This example is ok but it could be improved:

  • There is no error handling.
  • There is no check to ensure the cells contains a valid sheet name.
  • The sheet and range addresses are hard-coded.
  • The default sheets in the new workbook are not deleted.
Community
  • 1
  • 1
David Rushton
  • 4,915
  • 1
  • 17
  • 31