Excel export Active Sheet in one workbook to a new sheet in another

Dan Henery
Dan Henery used Ask the Experts™
on
I have 2 Excel Workbooks... I want to create a button in the first Workbook that will copy/extract the Active Sheet and save it to a New Sheet in an existing Workbook. I have found some different pieces of this puzzle but not sure how to make everything work.

Steps I am looking to do are:
1. Copy Active Sheet
2. Open Windows Explorer to choose an existing Workbook
3. Create a new sheet in that workbook
4. Paste copied sheet with formatting intact (Mainly column widths and row heights)
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2016

Commented:
Hi,

pls try
Sub macro()
Set sh = ActiveSheet
filetoOpen = Application.GetOpenFilename("Text Files (*.xls*), *.xls*")
If filetoOpen <> False Then
    Set wbk = Workbooks.Open(filetoOpen)
    sh.Copy Before:=wbk.Sheets(1)
End If
End Sub

Open in new window

Regards
Mike in ITIT System Administrator
Distinguished Expert 2017

Commented:
Do you have any code that you have already worked on?

Does the spreadsheet that you are wanting to copy always have the same size (i.e. number of columns, number of rows)? If so what are they?
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
Try this:
Sub CopyToWorkbook()
Dim fNameAndPath As Variant, Wb As Workbook
Dim CurSh As Worksheet
Set CurSh = ThisWorkbook.ActiveSheet
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.xl*),*.xl*", Title:="Select File To Be Copied")
  
    If fNameAndPath = False Then Exit Sub
    
Set Wb = Workbooks.Open(fNameAndPath)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
CurSh.Activate
CurSh.Copy Before:=Wb.Sheets(1)
Wb.Close savechanges:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Open in new window

Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Dan HeneryLead Infrastructure Engineer

Author

Commented:
Thanks RGonzo.. that gets me closer to what I am trying to accomplish. Now we need to refine it a bit... How would I just extract a specific range. I am attaching the source file. What I want is the data from Range A3 - F13 and need to keep the formatting
SV3200-Builder.xlsm
Dan HeneryLead Infrastructure Engineer

Author

Commented:
Nice... Even Better Shums... the only thing left is can I do this with only the A3 - F13 Range? I want to leave out the heading and the buttons from the source file
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
Hi Henery,

Try below to keep intact your formatting within the range:
Sub CopyToWorkbook()
Dim fNameAndPath As Variant, Wb As Workbook
Dim CurSh As Worksheet
Dim TrgtSh As Worksheet
Dim CopyRng As Range, TrgtRng As Range
Dim c As Long
Set CurSh = ThisWorkbook.ActiveSheet
Set CopyRng = CurSh.Range("A1:F13")
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.xl*),*.xl*", Title:="Select File To Be Copied")
  
    If fNameAndPath = False Then Exit Sub
    
Set Wb = Workbooks.Open(fNameAndPath)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Wb.Sheets.Add Before:=Wb.Sheets(1)
Set TrgtSh = Wb.ActiveSheet
Set TrgtRng = TrgtSh.Range("A1:F13")
CurSh.Activate
CopyRng.Copy
TrgtRng.PasteSpecial xlPasteValuesAndNumberFormats
TrgtRng.PasteSpecial xlPasteFormats
With CopyRng
    For c = 1 To .Columns.Count
        TrgtRng.Columns(c).ColumnWidth = .Columns(c).ColumnWidth
    Next c
End With
TrgtSh.Activate
TrgtSh.Range("A1").Select
Wb.Close savechanges:=True
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Open in new window

I have already created a button for Export to Excel, please find attached...
SV3200-Builder_v1.xlsm
Managing Director/Excel VBA Developer
Distinguished Expert 2018
Commented:
I missed your range from A3:F13.

Corrected with row height as well. please find attached...
SV3200-Builder_v2.xlsm
Top Expert 2016
Commented:
then try
Sub macro()
Set sh = ActiveSheet
filetoOpen = Application.GetOpenFilename("Text Files (*.xls*), *.xls*")
If filetoOpen <> False Then
    Set wbk = Workbooks.Open(filetoOpen)
    sh.Copy Before:=wbk.Sheets(1)
    Range(Range("G1"), Cells(1, columns.count)).EntireColumn.Delete
    Range(Range("A14"), Cells(Rows.count, "A")).EntireRow.Delete
    Range(Range("A1"), Cells(2, "A")).EntireRow.Delete
End If
End Sub

Open in new window

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial