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("D71041").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
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("D71041").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