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
ASKER
ASKER
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
I have already created a button for Export to Excel, please find attached...Microsoft Excel topics include formulas, formatting, VBA macros and user-defined functions, and everything else related to the spreadsheet user interface, including error messages.
TRUSTED BY
pls try
Open in new window
Regards