Save only a range from an excel file to another

[zero.stress]

Hello,
I have this problem, i want create a macro that create a new file with
a Range (Ex A1:B56)

Ex.
In the file X i have 4 sheets i want a macro that take all the data
From The sheet1 in the range A1:B56 and save this range as file Y.

I hope you understand what i need to do thanks in advance to every
one.

 

[Ron de Bruin]

Hi

See this mail macro for the code
Delete the mail stuff
http://www.rondebruin.nl/mail/folder1/mail4.htm

If you need more help post back

 

[zero.stress]

Hello Ron Thanks to reply! You code seems work but doesn't save the
file this i the code that i keep do you see any error?

Sub Mail_Range()


'Working in 2000-2007
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:H100").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected,
please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)

Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = "c:\temp\"
TempFileName = "Test"

If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsx": FileFormatNum = 51
End If

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error GoTo 0
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[zero.stress]

Hello Ron I just find the error, i deleted the last part

Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

and it's work!!

Thanks a lot! if you are from amsterdam i will pay a beertje

 

[Ron de Bruin]

It save the file mail it and delete it

Delete this line

Kill TempFilePath & TempFileName & FileExtStr

 

[Ron de Bruin]

You are welcome

Kill TempFilePath & TempFileName & FileExtStr

Only delete this line
One hour with the car