Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Excel 2003: macro to add data to next empty row

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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default Excel 2003: macro to add data to next empty row

It overwrites any data when you run it a second, third, ... time.

If that's not what you want, then maybe you can pick out a column that can be
used to determine the next row to use.

Then you could replace this single line:

dRow = 1 'always starts at row 1

with this:

with destsheet
drow = .cells(.rows.count,"X").end(xlup).row + 1
end with

I used column X, but you can use any column that you want--as long as it's
filled when that row is used.



Powerless user wrote:

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


--

Dave Peterson
  #3   Report Post  
Posted to microsoft.public.excel.programming
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


  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5
Default Excel 2003: macro to add data to next empty row

i would use .userrange to determine the last row in use.

dRow = destSheet.usedrange.rows.count + 1

then you do not inc(dRow) for each iteration but seek directly the 1st free
row.


"Powerless user" wrote:

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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel 2003 attachments open and show only empty cells when openedvia Outlook 2003? Rob Gordon Excel Discussion (Misc queries) 1 December 2nd 08 09:34 PM
Document.Body.InnerText is empty in Excel 2003 grove Excel Programming 0 April 17th 08 08:49 PM
Excel 2003 Macro to move data around worksheet recorder Excel Programming 1 March 25th 08 02:45 AM
Excel 2003, how can I delete all empty rows Edgar[_2_] Excel Discussion (Misc queries) 4 May 26th 07 03:06 AM
[excel 2003] Delete empty rows RedCell Excel Worksheet Functions 1 February 21st 06 11:18 AM


All times are GMT +1. The time now is 10:06 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"