Copying Selected Sheets into New Workbook

I am trying to copy the selected cells into a new workbook and then save it to a new workbook but I can't seem to make the transition from selecting the worksheets to pasting them in a new workbook.


Thanks for the help.  It's been stumping me for the entire day.    
-------
Public Const Baseloc = "H:\DistributeP-L\"
   Dim strDir As String
'Next Steps
'1) Copy into new workbook
'2) File

Sub Steps()

       If Dir(Baseloc, vbDirectory) = "" Then
        MkDir strDir
End If

    strDir = "" & Baseloc & Format(Date, "yyyy-mm-dd")
       If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    End If
        Dim PathName As String
       
        PathName = "" & strDir & "\"

   Dim Ws As Worksheet
    Dim n As Integer
   
           

           
     
   

Dim Placeholder As Integer
Dim FileName As String
FileName = ThisWorkbook.FullName

Dim RegionStart As Integer
Dim RegionEnd As Integer
Dim RegionHolder As String
Dim RegionName As String
RegionName = ActiveSheet.Name

Sheets("NE REGION").Select
RegionStart = ActiveSheet.Index
Placeholder = ActiveSheet.Index
RegionEnd = ActiveSheet.Index
'RegionHolder = "" & ActiveSheet.Name & Chr(34) & ""
Placeholder = Placeholder + 1
Sheets(Placeholder).Select

Do While Placeholder < Sheets.Count
If ActiveSheet.Name = "NE REGION" Or ActiveSheet.Name = "SE REGION" Or ActiveSheet.Name = "MW REGION" Then

Call SelectSheets(RegionStart, RegionEnd)

 Selection.Copy
   
'This is where first error happens

 MyBook = ActiveWorkbook.Name
Dim newBook As Workbook
Set newBook = Workbooks.Add

Sheets.Copy Before:=newBook.Sheets(1)

      Workbooks(MyBook).Activate ' Back to original book

   Set WB = ActiveWorkbook
 
   
   
  ' Set WB = NewBook
   
   Workbooks(newBook).Activate
   
   
   
      With ActiveWorkbook
      ActiveWorkbook.Paste
     
       On Error Resume Next
                .SaveAs PathName & RegionName & _
                        Format(Date, " yyyy-mm-dd")
                If Err = 0 Then n = n + 1
                .Close False
            End With
           
           

'CreateDailyDirectory
'Check if it's over
'Otherwise start again
If ActiveSheet.Index + 1 < Sheets.Count Then
RegionName = ActiveSheet.Name

RegionStart = ActiveSheet.Index + 1
RegionEnd = RegionStart
Placeholder = ActiveSheet.Index + 1
RegionHolder = ActiveSheet.Index

End If


Else
RegionEnd = Placeholder
Placeholder = Placeholder + 1
'RegionHolder = RegionHolder & ", " & Chr(34) & ActiveSheet.Name & Chr(34)


Sheets(Placeholder).Select

End If
Sheets(Placeholder).Select

Loop
End Sub



Private Sub CreateDailyDirectory()
 
    strDir = "" & Baseloc & Format(Date, "yyyy-mm-dd")
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    End If
   
   
End Sub

Sub SelectSheets(iStart As Integer, iEnd As Integer)

    Dim i As Integer
    Sheets(iStart).Select Replace:=True
    For i = iStart + 1 To iEnd
        Sheets(i).Select Replace:=False
    Next

End Sub
LVL 1
mattfmillerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieVBA ExpertCommented:
Instead of selecting the sheets you should create an array with the names of the sheets you want to copy and then use that to copy them.

For example if you wanted to copy Sheet1 and Sheet3 to a new workbook you could use this.
arrSheets  = Array("Sheet1", "Sheet3")

' copy worksheets to a new workbook
Sheets(arrSheets).Copy

Open in new window

Obviously that's a  very simple example and you would need code to create the array for your needs.

I would post something for that but it's not really clear which sheets you want to copy.

I think it's every sheet but the sheets named here but I'm not sure, it might actually be the opposite, ie these are the sheets you want to copy.
If ActiveSheet.Name = "NE REGION" Or ActiveSheet.Name = "SE REGION" Or ActiveSheet.Name = "MW REGION" Then

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mattfmillerAuthor Commented:
I'm close to a solution.  The reason I can't use static stuff is because they spreadsheets change every couple of months and the macro will be handed off to someone else.

I've managed to copy the worksheets into a new workbook,  I just need to figure out how to do it for a range of indexed sheets like 4 to 10 instead or just 1 to 4.

Thanks.
_____________
Sub SelectSheets()
Dim loopArray() As Variant
ReDim Preserve loopArray(1 To 1)
Sheets("NE REGION").Select

loopArray(1) = ActiveSheet.Name

    Dim i As Integer
    Dim theName As String
    Dim j As Integer
  j = 1

ActiveSheet.Next.Select

' iStart As Integer

  For Each loopSheet In ThisWorkbook.Sheets
    If loopSheet.Name <> "NE REGION" And loopSheet.Name <> "SE REGION"  Then
        theName = loopSheet.Name
        j = j + 1
        ReDim Preserve loopArray(1 To j)
        loopArray(j) = theName ' Assign the name of the sheets to j-th position of loopArray()
    Else
    Exit For
    End If
   
   
Next loopSheet

Sheets(loopArray()).Copy

Set newBook = ActiveWorkbook
newBook.Activate

'MsgBox ArrayHolder
Sheets(loopArray()).Copy
Set newBook = ActiveWorkbook
newBook.Activate
0
mattfmillerAuthor Commented:
I figured out the solution.


Sub SelectSheets()
Dim loopArray() As Variant
Dim Placeholder As Integer

ReDim Preserve loopArray(1 To 1)
Dim regionname As String

Sheets("NE Region").Select
Do While ActiveSheet.Index < Sheets.Count

loopArray(1) = ActiveSheet.Name
regionname = ActiveSheet.Name

    Dim i As Integer
    Dim theName As String
    Dim j As Integer
  j = 1

ActiveSheet.Next.Select

Do While ActiveSheet.Name <> "NE REGION" And ActiveSheet.Name <> "SE REGION"
        theName = ActiveSheet.Name
        j = j + 1
        ReDim Preserve loopArray(1 To j)
        loopArray(j) = theName ' Assign the name of the sheets to j-th position of loopArray()
Placeholder = Placeholder + 1

ActiveSheet.Next.Select

Loop

Sheets(loopArray()).Copy

Set newBook = ActiveWorkbook
newBook.Activate

'MsgBox ArrayHolder
'Sheets(loopArray()).Copy
Set newBook = ActiveWorkbook
newBook.Activate
'Method to Save ActiveSheet


 With ActiveWorkbook
                On Error Resume Next
                .SaveAs Baseloc & regionname & _
                        Format(Date, " yyyy-mm-dd")
            End With
           
            ActiveWorkbook.Close
           
Loop





End Sub
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

mattfmillerAuthor Commented:
Thank you for your help
0
NorieVBA ExpertCommented:
Glad you found a solution, I was going to post code but wasn't sure which sheets you wanted to copy.

If you could explain that I'd happily post some code.
0
mattfmillerAuthor Commented:
Yeah I wasn't too sure either since the worksheets change every couple of months and I needed to make it extra robust before handing it off to somebody else.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.