VBA Move one worksheet, Copy paste special the other worksheet both in to the same new book

[Melimob]

Hi

I have code to copy sheets into a new workbook but what I want to do is, move one and copy the other.

I.e.
Sheet1 > move
Sheet2 > copy paste special (to remove formulas)

then save the new workbook with file name as per cell A1 of Sheet2

However, I need the user to specify their own path since they'll be opening the original doc from SharePoint and different users will be using it.
I therefore can't use the below code right?

ThisFile = Sheets("Instructions").Range("A1").Value
    ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.path & Application.PathSeparator & ThisFile

Also, I need to save the new workbook as an .xlsx document (without macros)

I would also love it if it would attach to an email so they can send straight away but can live without this if needbe


Any advice gratefully received!

thank you!

 

[JLGWhiz]

See if this will work for you

Sub t()
Dim sh1 As Worksheet, sh2 As Worksheet, nm As String
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
sh1.Copy
ActiveWorkbook.Sheets.Add After:=Sheets(She4ets.Count)
sh2.UsedRange.Copy
ActiveWorkbook.Sheets(2).Range("A1").PasteSpecial xlPasteValues
nm = sh2.Range("A1")
fName = Application.GetSaveAsFilename(nm, "Excel Files (*.xl*), *.xl*")
ActiveWorkbook.SaveAs fName
End Sub

 

[Melimob]

See if this will work for you

Sub t()
Dim sh1 As Worksheet, sh2 As Worksheet, nm As String
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
sh1.Copy
ActiveWorkbook.Sheets.Add After:=Sheets(She4ets.Count)
sh2.UsedRange.Copy
ActiveWorkbook.Sheets(2).Range("A1").PasteSpecial xlPasteValues
nm = sh2.Range("A1")
fName = Application.GetSaveAsFilename(nm, "Excel Files (*.xl*), *.xl*")
ActiveWorkbook.SaveAs fName
End Sub

Hi JLGWhiz

Thank you for this but it didn't quite work. I think my criteria has changed now. I don't mind saving as .xlsm if needbe.

Here's my adapted code which is erroring now:

Sub ExportPtnrConfig()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, nm As String
Set sh1 = Sheets("Partner Instructions")
Set sh2 = Sheets("Reconfig Partner to Complete")
Set sh3 = Sheets("Tech FootPrint")


sh1.Copy
'ActiveWorkbook.Sheets(2).Range("A1").PasteSpecial xlPasteValues


sh2.Move
ActiveWorkbook.Sheets.Add After:=Sheets(Sheets.Count)


sh3.Copy




'For Each sh In ActiveWorkbook.Worksheets
    'If sh.Name <> "Reconfig Partner to Complete" Then
          
      With sh.UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
       End With
       Application.CutCopyMode = False
    'End If
'Next sh
     
Protect
   
nm = sh3.Range("A1")
fName = Application.GetSaveAsFilename(nm, "Excel Files (*.xl*), *.xl*")
ActiveWorkbook.SaveAs fName




End Sub

 

[JLGWhiz]

hi Melimob, Sorry about the typo in my first post. I could have sworn I fixed that.
In your revised code, you are using sh1.Copy and sh3.Copy without specifying a destination. When you do that, it creates a new workbook which becomes the ActiveWorkbook. Also, the sh2.Move statement needs a destination of Before:= or After:= for it to be able to execute.

If you can explain what your current objective is, I will try to write the code for it without the typos this time. But right now I am a little confused about what you want to do with each sheet and which workbook you want to do it in.

 

[Melimob]

hi Melimob, Sorry about the typo in my first post. I could have sworn I fixed that.
In your revised code, you are using sh1.Copy and sh3.Copy without specifying a destination. When you do that, it creates a new workbook which becomes the ActiveWorkbook. Also, the sh2.Move statement needs a destination of Before:= or After:= for it to be able to execute.

If you can explain what your current objective is, I will try to write the code for it without the typos this time. But right now I am a little confused about what you want to do with each sheet and which workbook you want to do it in.

Hey JLGWhiz thanks for your help. Sorry I was in a rush yesterday and realise I didn't explain myself very well so sorry for confusion.

I want to:

1. Create a new workbook with 3 (maybe 4 now) sheets.

"Partner Instructions" sheet > should copy as first sheet.
This should keep the formats but just remove any formulas so copy but then copy over itself as paste special values.
Actually the only formulas here are in B2 (it's a merged cell though) so could just copy over that first. and A1 which has the name of what the file should be called as a formula:

"Reconfig Partner to Complete" sheet > should MOVE to new workbook so it is not saved in current and move as sheet 2

"Tech FootPrint" sheet > should be copied as 3rd sheet.
Again, keep formats and values (i.e. remove any formulas).

I need the name of the file to generate from Partner Instructions tab cell A1 but ask the user to save where they want to and preferably, save without macros.

Many thanks for any advice.

Meli

 

[Melimob]

Hey JLGWhiz thanks for your help. Sorry I was in a rush yesterday and realise I didn't explain myself very well so sorry for confusion.

I want to:

1. Create a new workbook with 3 (maybe 4 now) sheets.

"Partner Instructions" sheet > should copy as first sheet.
This should keep the formats but just remove any formulas so copy but then copy over itself as paste special values.
Actually the only formulas here are in B2 (it's a merged cell though) so could just copy over that first. and A1 which has the name of what the file should be called as a formula:

"Reconfig Partner to Complete" sheet > should MOVE to new workbook so it is not saved in current and move as sheet 2

"Tech FootPrint" sheet > should be copied as 3rd sheet.
Again, keep formats and values (i.e. remove any formulas).

I need the name of the file to generate from Partner Instructions tab cell A1 but ask the user to save where they want to and preferably, save without macros.

Many thanks for any advice.

Meli

actually.. Partner instructions already has formulas removed so all good there just need to copy to nee wb.

 

[JLGWhiz]

See if this does it.

Sub t2()
Dim wb As Workbook
Set wb = Workbooks.Add
With ThisWorkbook
    .Sheets("Partner Instructions").Copy After:=wb.Sheets(wb.Sheets.Count)
    .Sheets("Reconfig Partner to Complete").Copy After:=wb.Sheets(wb.Sheets.Count)
    With wb.Sheets(wb.Sheets.Count).UsedRange
        .Value = .Value
    End With
    .Sheets("Tech FootPrint").Copy After:=wb.Sheets(wb.Sheets.Count)
    With wb.Sheets(wb.Sheets.Count).UsedRange
        .Value = .Value
    End With
End With
End Sub

 

[Melimob]

See if this does it.

Sub t2()
Dim wb As Workbook
Set wb = Workbooks.Add
With ThisWorkbook
    .Sheets("Partner Instructions").Copy After:=wb.Sheets(wb.Sheets.Count)
    .Sheets("Reconfig Partner to Complete").Copy After:=wb.Sheets(wb.Sheets.Count)
    With wb.Sheets(wb.Sheets.Count).UsedRange
        .Value = .Value
    End With
    .Sheets("Tech FootPrint").Copy After:=wb.Sheets(wb.Sheets.Count)
    With wb.Sheets(wb.Sheets.Count).UsedRange
        .Value = .Value
    End With
End With
End Sub

thank you JLGWHiz.. I adapted it slightly and it works but doesn't name the new workbook but I guess I can live without that

Here's my final code:

Sub ExportPtnrConfig()


Dim wb As Workbook
Set wb = Workbooks.Add


Application.ScreenUpdating = False


With ThisWorkbook
    .Sheets("Partner Instructions").Copy After:=wb.Sheets(wb.Sheets.Count)
    .Sheets("Reconfig Partner to Complete").Move After:=wb.Sheets(wb.Sheets.Count)
    'With wb.Sheets(wb.Sheets.Count).UsedRange
       ' .Value = .Value
    'End With
    .Sheets("Tech FootPrint").Copy After:=wb.Sheets(wb.Sheets.Count)
    .Sheets("Tech FootPrint").UnProtect
    With wb.Sheets(wb.Sheets.Count).UsedRange
        .Value = .Value
    End With
    .Sheets("Tech FootPrint").Protect




End With


ActiveWorkbook.Sheets("Partner Instructions").Activate
ActiveSheet.Range("A3").Select




Application.ScreenUpdating = True


End Sub

thank you so much again!

 

[Melimob]

thank you JLGWHiz.. I adapted it slightly and it works but doesn't name the new workbook but I guess I can live without that

Here's my final code:

Sub ExportPtnrConfig()


Dim wb As Workbook
Set wb = Workbooks.Add


Application.ScreenUpdating = False


With ThisWorkbook
    .Sheets("Partner Instructions").Copy After:=wb.Sheets(wb.Sheets.Count)
    .Sheets("Reconfig Partner to Complete").Move After:=wb.Sheets(wb.Sheets.Count)
    'With wb.Sheets(wb.Sheets.Count).UsedRange
       ' .Value = .Value
    'End With
    .Sheets("Tech FootPrint").Copy After:=wb.Sheets(wb.Sheets.Count)
    .Sheets("Tech FootPrint").UnProtect
    With wb.Sheets(wb.Sheets.Count).UsedRange
        .Value = .Value
    End With
    .Sheets("Tech FootPrint").Protect




End With


ActiveWorkbook.Sheets("Partner Instructions").Activate
ActiveSheet.Range("A3").Select




Application.ScreenUpdating = True


End Sub

thank you so much again!

thank you again, I managed to figure out how to name it also!

Sub ExportPtnrConfig()


Dim wb As Workbook
Aname = ActiveWorkbook.Sheets("Partner Instructions").Range("A1").Value
Set wb = Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Aname & ".xlsx"
Application.ScreenUpdating = False


With ThisWorkbook
    .Sheets("Partner Instructions").Copy After:=wb.Sheets(wb.Sheets.Count)
    .Sheets("Reconfig Partner to Complete").Move After:=wb.Sheets(wb.Sheets.Count)
    .Sheets("Tech FootPrint").Copy After:=wb.Sheets(wb.Sheets.Count)
    .Sheets("Tech FootPrint").UnProtect
    With wb.Sheets(wb.Sheets.Count).UsedRange
        .Value = .Value
    End With
    .Sheets("Tech FootPrint").Protect


End With


ActiveWorkbook.Sheets("Partner Instructions").Activate
ActiveSheet.Range("A3").Select


Application.ScreenUpdating = True


End Sub

 

[JLGWhiz]

Glad you figured it out and thanks for the feedback,
Regards, JLG