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)

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

Mike in IT

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?

Shums Faruk

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 Henery

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

Dan Henery

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

Shums Faruk

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

Shums Faruk

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

SOLUTION

Rgonzo1971

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer