minor modification to macro, need to delete cells

[Guest]

can someone help me add to his macro, after it copys each line I need it to
delete the values in the A Column , E Column and F column, but i cant figure
it out.. anyone help would be appreciated. Thanks!


Sub CopyToSheetz()

Dim rng As Range
Dim oCell As Range

Set rng = Range("B4:B" & Cells(Rows.Count, "B").End(xlUp).Row)
For Each oCell In rng
oCell.EntireRow.Copy _
Destination:=Sheets(oCell.Value).Range("A65536").End(xlUp).Offset(1,
0)


Next oCell


End Sub

 

[Jim Cone]

Michael,

This seems to work...
'---------------------------------------------
Sub CopyToSheetz()
Dim rng As Range
Dim oCell As Range
Dim lngCell As Long

lngCell = Cells(Rows.Count, 2).End(xlUp).Row

Set rng = Range(Cells(4, 2), Cells(lngCell, 2))
For Each oCell In rng
oCell.EntireRow.Copy _
Destination:=Sheets(oCell.Value).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next oCell
Range(Cells(4, 1), Cells(lngCell, 1)).ClearContents
Range(Cells(4, 5), Cells(lngCell, 6)).ClearContents
End Sub
'--------------------------------------------

Jim Cone
San Francisco, USA

 

[Guest]

Michael,
Not sure from you post if you want to clear cell A,E & F in the source sheet
or the destination sheet. Below is guessing the Dest sheet.

Sub CopyToSheetz()

Dim rng As Range
Dim oCell As Range
Dim Dest as Range

Set rng = Range("B4:B" & Cells(Rows.Count, "B").End(xlUp).Row)
For Each oCell In rng
Set Dest = Sheets(oCell.Value).Range("A65536").End(xlUp).Offset(1,
0)
oCell.EntireRow.Copy Dest
'Clear cell A,E, and F
Dest.Clearcontents
Dest.Offset(0,4).ClearContents
Dest.Offset(0,5).ClearContents

Next oCell

Set Dest = Nothing
Set Rng = Nothing
Set oCell = Nothing
End Sub