View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Gary Keramidas Gary Keramidas is offline
external usenet poster
 
Posts: 2,494
Default Excel 2003: macro to add data to next empty row

and as some additional info to dave's post, i would always qualify the ranges.

use something like this so you always use the correct sheet. if you happen to
run the code and another sheet is active, it won't work.


For sRow = 1 To Range("B65536").End(xlUp).Row
'use pattern matching to find "9365" anywhere in cell
With Worksheets("Sheet1")
If .Cells(sRow, "B") Like "*9365*" Then
sCount = sCount + 1
dRow = dRow + 1
'copy cols A,D,F,H,J,L,M & N
.Cells(sRow, "A").Copy
Destination:=DestSheet.Cells(dRow, "A")
.Cells(sRow, "d").Copy
Destination:=DestSheet.Cells(dRow, "B")
.Cells(sRow, "f").Copy
Destination:=DestSheet.Cells(dRow, "C")
.Cells(sRow, "h").Copy
Destination:=DestSheet.Cells(dRow, "D")
.Cells(sRow, "J").Copy
Destination:=DestSheet.Cells(dRow, "E")
.Cells(sRow, "L").Copy
Destination:=DestSheet.Cells(dRow, "F")
.Cells(sRow, "M").Copy
Destination:=DestSheet.Cells(dRow, "G")
.Cells(sRow, "N").Copy
Destination:=DestSheet.Cells(dRow, "H")
End If
End With
Next sRow
--


Gary Keramidas
Excel 2003


"Powerless user" <Powerless wrote in message
...
When I run this macro with new data it overwrites instead of pasting to the
next empty row in the destination sheet. Any suggestions?

Sub Copy9365()
'Copy cells of cols A,D,F,H,J,L,M,N from rows containing "9365" in
'col B of the active worksheet (source sheet) to cols
',A-H of Tester (destination sheet)
Dim DestSheet As Worksheet
Set DestSheet = Worksheets("tester")

Dim sRow As Long 'row index on source worksheet
Dim dRow As Long 'row index on destination worksheet
Dim sCount As Long
sCount = 0
dRow = 1

For sRow = 1 To Range("B65536").End(xlUp).Row
'use pattern matching to find "9365" anywhere in cell
If Cells(sRow, "B") Like "*9365*" Then
sCount = sCount + 1
dRow = dRow + 1
'copy cols A,D,F,H,J,L,M & N
Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A")
Cells(sRow, "d").Copy Destination:=DestSheet.Cells(dRow, "B")
Cells(sRow, "f").Copy Destination:=DestSheet.Cells(dRow, "C")
Cells(sRow, "h").Copy Destination:=DestSheet.Cells(dRow, "D")
Cells(sRow, "J").Copy Destination:=DestSheet.Cells(dRow, "E")
Cells(sRow, "L").Copy Destination:=DestSheet.Cells(dRow, "F")
Cells(sRow, "M").Copy Destination:=DestSheet.Cells(dRow, "G")
Cells(sRow, "N").Copy Destination:=DestSheet.Cells(dRow, "H")

End If
Next sRow
Sheets("tester").Select

End Sub