Copy Sheet to Desktop

  • Thread starter RE: VLOOKUP fORMULA
  • Start date
R

RE: VLOOKUP fORMULA

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
 
J

JLGWhiz

I did not test this so it might hiccup. If so, post back and I'll fix it.
I basically just cleaned up the code by removing a lot of unneeded select
and selection verbiage.

Sub MacroEmailPOB()
Sheets("Email").Visible = True
With Sheets("Email")
.ClearContents
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Sheets("Email")
.Columns("A:A").ColumnWidth = 3.29
.Columns("B:B").ColumnWidth = 4.86
.Columns("C:C").ColumnWidth = 3.71
.Columns("D:D").ColumnWidth = 19.14
.Columns("E:E").ColumnWidth = 10.14
.Columns("F:F").ColumnWidth = 9.43
.Columns("G:G").ColumnWidth = 10
.Columns("H:I").ColumnWidth = 8.14
.Columns("J:J").ColumnWidth = 5.43

Sheets("CrewList").Range("total").Copy
With Sheets("Email").Range("A1")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With.
Application.CutCopyMode = False


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.edSheets.Visible = False .
Application.GoTo Sheets("CrewList").Range("A1").
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top