We help IT Professionals succeed at work.

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

143 Views
Last Modified: 2017-03-16
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

CERTIFIED EXPERT
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
CERTIFIED EXPERT
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

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
CERTIFIED EXPERT
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
CERTIFIED EXPERT
Distinguished Expert 2018
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION
CERTIFIED EXPERT
Top Expert 2016
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions