View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
VLOOKUP fORMULA  VLOOKUP fORMULA is offline
external usenet poster
 
Posts: 32
Default Copy Sheet to Desktop

Any body please help me.......

I would like to copy a range from an excel file (without any formula and
with the format) and paste on desktop as a new excel file.

For the above purpose I was using the below macro, but it is taking around 5
minutes to export this file to the desk top. Is there any other way to do so?

Is there any error on the below macro?

Kindly help on this matter.


Sub MacroEmailPOB()
Sheets("Email").Visible = True
Sheets("Email").Select

Cells.Select
Selection.ClearContents
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Columns("A:A").Select
Selection.ColumnWidth = 3.29
Columns("B:B").Select
Selection.ColumnWidth = 4.86
Columns("C:C").Select
Selection.ColumnWidth = 3.71
Columns("D:D").Select
Selection.ColumnWidth = 19.14
Columns("E:E").Select
Selection.ColumnWidth = 10.14
Columns("F:F").Select
Selection.ColumnWidth = 9.43
Columns("G:G").Select
Selection.ColumnWidth = 10
Columns("H:I").Select
Selection.ColumnWidth = 8.14
Columns("J:J").Select
Selection.ColumnWidth = 5.43

Sheets("CrewList").Select
Range("total").Select

Selection.Copy
Sheets("Email").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("D12").Select
ActiveWindow.SmallScroll Down:=-15
Range("A1").Select
Sheets("CrewList").Select
Application.CutCopyMode = False
Range("A1").Select
Sheets("Email").Select
Range("A1").Select
Sheets("Email").Select
Sheets("Email").Copy
ChDir "C:\Documents and Settings\radio\Desktop"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\radio\Desktop\POB.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False

ActiveWindow.Close
ActiveWindow.SelectedSheets.Visible = False
Range("L7").Select
Sheets("CrewList").Select
Range("A1").Select

End Sub