VBA Help Please - Moving Sheets from Existing Workbook into a Brand New Workbook

[Simonc64]

Hi All, I am a VBA novice but have managed to write a script to create a new workbook in my desired location; what I want to do now is copy say 3 or 4 sheets from and exsiting workbook to this new workbook, but all in one routine if thats possible; my logic being create new workbook, then copy said sheets into it - hope that makes sense!

Anyway this code works for creating the new workbook.........

Sub NewWorkBook
Dim NewBook As Workbook
Dim n As Integer
Dim start As Integer

Set NewBook = Workbooks.Add
With NewBook
start = .Worksheets.Count + 1
If start < 5 Then

For n = start To 5
.Sheets.Add After:=Sheets(n - 1)
Next n
For n = 1 To 5
.Worksheets.Name = n
Next n
End If
.SaveAs Filename:="S:\Managers Data Reports-058\Assessment Summaries\ABC.xlsx"
End With
End Sub

Thats fine but then im trying to add in the following code to add specific sheets to that workbook using........................

Workbooks("S:\Managers Data Reports-058\Assessment Summaries\XYZ,xlsx").Sheets("Due in 5-10 Days").Copy _
After:=Workbooks("S:\Managers Data Reports-058\Assessment Summaries\ABC.xlsx").Sheets(Workbooks("S:\Managers Data Reports-058\Assessment Summaries\ABC.xlsx").Sheets.Count)

This is where it falls over and quite honestly I dont have a clue !

Any help as always gratefully received

 

[Simonc64]

PS I know the title of the post says MOVE but i actually want to COPY the sheets - apologies !

 

[HaHoBe]

Hi,

if the workbook is open it should only be

Workbooks("XYZ,xlsx")

otherwise the workbook has to be opened before copying the sheet.

Sub NewWorkBook()
Dim NewBook As Workbook
Dim n As Integer
Dim start As Integer

Set NewBook = Workbooks.Add
With NewBook
  start = .Worksheets.Count + 1
  If start < 5 Then
  
    For n = start To 5
      .Sheets.Add After:=Sheets(n - 1)
    Next n
    For n = 1 To 5
      .Worksheets(n).Name = n
    Next n
  End If
  .SaveAs Filename:="S:\Managers Data Reports-058\Assessment Summaries\ABC.xlsx"
  Workbooks("XYZ,xlsx").Sheets("Due in 5-10 Days").Copy _
      After:=.Worksheets(.Worksheets.Count)
End With
End Sub

Sub NewWorkBook_2()
Dim NewBook As Workbook
Dim wbkXYZ As Workbook
Dim n As Integer
Dim start As Integer

Set NewBook = Workbooks.Add
With NewBook
  start = .Worksheets.Count + 1
  If start < 5 Then
  
    For n = start To 5
      .Sheets.Add After:=Sheets(n - 1)
    Next n
    For n = 1 To 5
      .Worksheets(n).Name = n
    Next n
  End If
  .SaveAs Filename:="S:\Managers Data Reports-058\Assessment Summaries\ABC.xlsx"
  Set wbkXYZ = Workbooks.Open("S:\Managers Data Reports-058\Assessment Summaries\XYZ,xlsx")
  wbkXYZ.Sheets("Due in 5-10 Days").Copy _
      After:=.Worksheets(.Worksheets.Count)
End With
End Sub

Ciao,
Holger

 

[Simonc64]

Hi Holger thank you for your reply and assistance - sorry but i will need more explanation

All I need to do is create a new workbook "ABC", save it and then copy a couple of sheets from "XYZ" into "ABC"

The code will be resident in "XYZ" so at the press of a buton the new workbook will created, saved and updated

Does that make sense?

 

[HaHoBe]

Hi Simonc64,

any workbook containing code should either have the suffix xlsm or xlsb (or be an addin xlam). So you would to have save your XYZ.XLSX as XYZ.XLSM (macro enabled workbook) in order to make it work.

As you save the workbook with just a name please allow the question what should happen the next time you want to run the macro. Right now a message would appear that a workbook of the given name already exists at the place: should the workbook be replaced (can be done without getting the message) or is it an option to add a day and time stamp to the name so that any workbook can be saved?

Ciao,
Holger

 

[Simonc64]

Hi Simonc64,

any workbook containing code should either have the suffix xlsm or xlsb (or be an addin xlam). So you would to have save your XYZ.XLSX as XYZ.XLSM in order to make it work.

As you save the workbook with just a name please allow the question what should happen the next time you want to run the macro. Right now a message would appear that a workbook of the given name already exists at the place: should the workbook be replaced (can be done without getting the message) or is it an option to add a day and time stamp to the name so that any workbook can be saved?

Ciao,
Holger

Thanks again Holger - yes thats a good point and noted! Giving it some thought, it would be better to have the same filename with a datestamp to build up a catalogue of reports over the year

 

[HaHoBe]

Hi Simonc64,

working on the code I realized that I had used a comma instead of a dot - it must be xyz.xlsx and not xyz,xlsx.

Code is for the workbook which holds the sheet to be copied (according to the above it could be named XYZ.xlsm), code goes into a standard module:

Sub NewWorkBook_3()
Dim wbkNewBook As Workbook
Dim lngCounter As Long

'///get the number of sheets in new workbook, alter it to 5, switch back to normal
lngCounter = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 5
Set wbkNewBook = Workbooks.Add
Application.SheetsInNewWorkbook = lngCounter

With wbkNewBook
  For lngCounter = 1 To 5
    .Worksheets(lngCounter).Name = lngCounter
  Next lngCounter
  .SaveAs Filename:="S:\Managers Data Reports-058\Assessment Summaries\ABC " & Format(Now, "yymmdd_hhmmss") & "xlsx"
  ThisWorkbook.Sheets("Due in 5-10 Days").Copy After:=.Worksheets(.Worksheets.Count)
  .Save
  '/// if you want to close the new book comment out the next codeline
'  .Close True
End With

Set wbkNewBook = Nothing

End Sub

Ciao,
Holger

 

[Simonc64]

Hi Holger - amazing thank you !! One last question, if i wanted to copy a 2nd sheet from the same sourse to the new filw would i just repeat the command a second time and change the sheet name?

 

[HaHoBe]

Hi Simonc64,

there is nothing wrong in doubling and altering the codeline for the sheet name. Or use this codeline instead

  ThisWorkbook.Sheets(Array("Due in 5-10 Days", "Another Sheet")).Copy After:=.Worksheets(.Worksheets.Count)

Ciao,
Holger

 

[Simonc64]

Thank you so much Holger -very much appreciated !