Avatar of Dan Henery
Dan HeneryFlag for United States of America

asked on 

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

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)
Microsoft OfficeMicrosoft ExcelVBA

Avatar of undefined
Last Comment
Rgonzo1971
Avatar of Rgonzo1971
Rgonzo1971

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
Avatar of Mike in IT
Mike in IT
Flag of United States of America image

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?
Avatar of Shums Faruk
Shums Faruk
Flag of India image

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

Avatar of Dan Henery
Dan Henery
Flag of United States of America image

ASKER

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
Avatar of Dan Henery
Dan Henery
Flag of United States of America image

ASKER

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
Avatar of Shums Faruk
Shums Faruk
Flag of India image

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
ASKER CERTIFIED SOLUTION
Avatar of Shums Faruk
Shums Faruk
Flag of India image

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
SOLUTION
Avatar of Rgonzo1971
Rgonzo1971

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
Microsoft Excel
Microsoft Excel

Microsoft Excel topics include formulas, formatting, VBA macros and user-defined functions, and everything else related to the spreadsheet user interface, including error messages.

144K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
Ask the experts
Read over 600 more reviews

TRUSTED BY

IBM logoIntel logoMicrosoft logoUbisoft logoSAP logo
Qualcomm logoCitrix Systems logoWorkday logoErnst & Young logo
High performer badgeUsers love us badge
LinkedIn logoFacebook logoX logoInstagram logoTikTok logoYouTube logo