excel macro stops

J

JOSEPH WEBER

I created a macro to split up a file into several files. When trying to do
something else on the computer, the macro stops. email for example. Here is
the code I used. Is there something in here i am missing that is causing the
macro to stop in the middle of processing? also to note, I created the macro
in XL2003 and am using it in XL2007.


Sheets("Sheet1").Select
Cells.UnMerge
Columns("C:E").Select
Application.CutCopyMode = False
Selection.Delete
Range("d7:g3000").Select
Selection.Delete
Range("e7:e3000").Delete
Range("f7:f3000").Delete
Range("g7:h3000").Delete
Range("h7:k3000").Delete

Range("d5").Select
Selection.Cut
Range("c5").Select
ActiveSheet.Paste

Range("h5").Select
Selection.Cut
Range("d5").Select
ActiveSheet.Paste

Range("j5").Select
Selection.Cut
Range("e5").Select
ActiveSheet.Paste

Range("l5").Select
Selection.Cut
Range("f5").Select
ActiveSheet.Paste

Range("p5").Select
Selection.Cut
Range("g5").Select
ActiveSheet.Paste

Range("t5").Select
Selection.Cut
Range("h5").Select
ActiveSheet.Paste

Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("E:E").ColumnWidth = 11.43
Columns("F:F").EntireColumn.AutoFit
Range("C2:F3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge

Range("a3").Select
Selection.Copy
Sheets("sheet2").Select
Range("a13").Select
ActiveSheet.Paste



Sheets("sheet2").Select
Range("a14").Select
ActiveCell.FormulaR1C1 = "1"

Sheets("sheet1").Select
Range("a6").Select
ActiveWorkbook.Names.Add Name:="Salesp", RefersToR1C1:=ActiveCell
Range("a6").Select
Selection.Copy
Application.Goto reference:="name"
ActiveSheet.Paste
Application.Goto reference:="Salesp"
Do Until Range("salesp") = "xxx"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveWorkbook.Names.Add Name:="Salesp", RefersToR1C1:=ActiveCell
If Range("Salesp") <> "" Then Call new_worksheet

Application.Goto reference:="count"
ActiveCell.FormulaR1C1 = Range("COUNT") + 1
Application.Goto reference:="salesp"
' ActiveCell.Offset(1, 0).Range("A1").Select


Loop
' Selection.UnMerge
End Sub
Sub new_worksheet()

ActiveCell.Offset(-1, 0).Range("a1").Select

NCOUNT = Range("count")
N = ActiveCell.Row
Q = Range("Filename")
p = ("4:5")
flirty = N - NCOUNT + 1 & ":" & N
' Application.Goto reference:="Salesp"
' ActiveCell.Offset(-1, 0).Range("a1").Select

Range(flirty).Copy
Sheets("sheet4").Select
Range("a3").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("4:5").Copy
Sheets("sheet4").Select
Range("a1").Select
ActiveSheet.Paste
ActiveCell.Offset(NCOUNT + 1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "Commission Total"
ActiveCell.EntireRow.Select

Selection.Font.bold = True
Range("a1:i3000").Copy


'Range("4:5").Select
'Range(flirty).Copy
'Sheets("sheet3").Select
'Range("a1").Select
'ActiveSheet.Paste
' Rows("Salesp").Select


Workbooks.Add
ActiveSheet.Paste
'On Error GoTo error

spath = "\\main\MyDocuments\jweber\sales commission reports\"
ActiveWorkbook.SaveAs spath & Q
ActiveWindow.Close
Windows("joann.XLS").Activate
Application.Goto reference:="count"
ActiveCell.FormulaR1C1 = 0
Sheets("sheet4").Select
Cells.clearcontents

Call pastename

End Sub
Sub pastename()
Application.Goto reference:="salesp"
Selection.Copy
Application.Goto reference:="name"
ActiveSheet.Paste
End Sub
Sub newsd()

Range("D6:F1135").Select
Selection.Delete Shift:=xlToLeft
Range("D7:D1041").Select
Selection.Delete Shift:=xlToLeft
Range("E7:E1180").Select
Selection.Delete Shift:=xlToLeft
Range("F7:F1105").Select
Selection.Delete Shift:=xlToLeft

Range("G246").Select

Range("H7:H987").Select
Selection.Delete Shift:=xlToLeft
Range("I7:L1078").Select
Selection.Delete Shift:=xlToLeft

Range("D5").Select
Selection.Cut Destination:=Range("C5")
Range("H5").Select
Selection.Cut Destination:=Range("D5")
Range("J5").Select
Selection.Cut Destination:=Range("E5")
Range("L5").Select
Selection.Cut Destination:=Range("F5")
Range("P5").Select
Selection.Cut Destination:=Range("H5")
Range("H5").Select

Range("T5").Select
Selection.Cut Destination:=Range("I5")
Range("I5").Select

Range("Q3").Select
Selection.Cut Destination:=Range("I3")
Range("I3").Select

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

Similar Threads


Top