Moving sheets to a new workbook

[rey06]

Hello -

I have this code below which works great for moving each sheet to its own workbook. However, I would like to tweak it to move the sheets (with the exception of MACRO and INPUT to ONE workbook while staying on separate sheets. I've been able to get them to all move to the same sheet in a new workbook, but I really do need them to stay on their own tabs.

Sub LoadingSheetSplitBook()
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
    Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        datebox = InputBox("Loading Sheets: Enter date: Format YYYYDDMM")
For Each xWs In ThisWorkbook.Sheets
    If xWs.Name <> "MACRO" Then
        If xWs.Name <> "INPUT" Then
            xWs.Copy
                        Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & datebox & "_" & xWs.Name & "_LOADING SHEET" & ".xlsx"
                        Application.ActiveWorkbook.Close False
                            End If
End If
    Next
        Application.DisplayAlerts = True
            Application.ScreenUpdating = True
End Sub

[GTO]

Greetings and welcome to vbaexpress :-)

I am not sure of what you want, as you mention 'Moving' in the thread title and in your verbiage as well, but show .Copy in your code. I am guessing that we want to copy...

In a Standard Module:

Option Explicit
'
Sub example()
Dim WB As Workbook
Dim wks As Worksheet
'
  Set WB = Workbooks.Add(xlWBATWorksheet)
'
  For Each wks In ThisWorkbook.Worksheets
    If Not wks.Name = "MACRO" And Not wks.Name = "INPUT" Then
      wks.Copy After:=WB.Worksheets(WB.Worksheets.Count)
    End If
  Next
'
  If WB.Worksheets.Count > 1 Then
    Application.DisplayAlerts = False
    WB.Worksheets(1).Delete
    Application.DisplayAlerts = True
  Else
    WB.Saved = True
    WB.Close False
  End If
'
End Sub

Hope that helps,

Mark

[rey06]

Thanks! This is pretty close to what I want! Is there a way to save this in the same location as file I run the macro from and have an input box to enter what I'd like to name the file? (I mean, I know there is a way but can you help me out? )

[GTO]

Check out Application.GetSaveAsFilename in VBA Help and see if you can make progress with that. I'll check back tonight.

[rey06]

I'm unfortunately not having an luck. The code you sent works fine, but I would just like it to save in the same folder as the file I run the macro from rather than opening, if that makes sense.
Appreciate your help so far!

[rey06]

I made a little progress. I now have an input box that lets me name my file and it saves in the right places, but there is only one sheet copied over. I think it still might be set to copy sheet by sheet instead of all the sheets. Any idea on how to change that?

Sub LoadingSheet()
Dim WB As Workbook
    Dim wks As Worksheet
xPath = Application.ActiveWorkbook.Path
    Application.ScreenUpdating = False
        Application.DisplayAlerts = False
         datebox = InputBox("Enter Desired File Name")
For Each xWs In ThisWorkbook.Sheets
    If xWs.Name <> "MACRO" Then
        If xWs.Name <> "INPUT" Then
            xWs.Copy
                        Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & datebox & ".xlsx"
                        Application.ActiveWorkbook.Close False
                            End If
End If
    Next
        Application.DisplayAlerts = True
            Application.ScreenUpdating = True
End Sub

[mikerickson]

Dim ws As WorkSheet
Dim nws as Worksheet
Dim Flag As Boolean

Flag = False
For each ws in ThisWorkbook.Sheets
    If ws.Name <> "Macro" and ws.Name <> "Input" Then
    
        If Flag then
            ws.Copy after:=nws
        Else
            ws.Copy
            Set nws = ActiveSheet
            Flag = True
        End If
    End If
Next ws

[rey06]

Dim ws As WorkSheet
Dim nws as Worksheet
Dim Flag As Boolean

Flag = False
For each ws in ThisWorkbook.Sheets
    If ws.Name <> "Macro" and ws.Name <> "Input" Then
    
        If Flag then
            ws.Copy after:=nws
        Else
            ws.Copy
            Set nws = ActiveSheet
            Flag = True
        End If
    End If
Next ws

Hello, thanks for the reply! I'm very new to VBA, and I'm a little confused by this. Do I just need to insert this somewhere into the code I have and does it still allow me to rename the spreadsheet with an input box and automatically save to the same location as the parent spreadsheet I run the macro from?

[mikerickson]

That code substitutes for your For each XWS loop from the OP.

[rey06]

Thanks! This works! Have a good one.