Add code to paste data to next available row

[J.W. Aldridge]

Code works fine....
Just want to ammend code to paste on next available row on "Data"
sheet.
....starting in column A.

Sub ABC()
Dim cell As Range, c As Range
Dim i As Range, rw As Long
Dim sh As Worksheet
With Worksheets("List")
Set c = .Range(.Cells(6, "B"), .Cells(6, "B").End(xlDown))
Set i = .Range(.Cells(6, "I"), .Cells(6, "I").End(xlDown))
End With
rw = 2

Set sh = Worksheets("Data")
For Each cell In c
If Application.CountIf(i, cell) > 0 Then
Range(cell, Cells(cell.Row, "G")).Copy sh.Cells(rw, 1)
rw = rw + 1
End If
Next
End Sub

 

[meh2030]

Code works fine....
Just want to ammend code to paste on next available row on "Data"
sheet.
...starting in column A.

Sub ABC()
Dim cell As Range, c As Range
Dim i As Range, rw As Long
Dim sh As Worksheet
With Worksheets("List")
Set c = .Range(.Cells(6, "B"), .Cells(6, "B").End(xlDown))
Set i = .Range(.Cells(6, "I"), .Cells(6, "I").End(xlDown))
End With
rw = 2

Set sh = Worksheets("Data")
For Each cell In c
If Application.CountIf(i, cell) > 0 Then
    Range(cell, Cells(cell.Row, "G")).Copy sh.Cells(rw, 1)
    rw = rw + 1
End If
Next
End Sub

You already have one type of answer in your code (i.e. the .End).
Also, try to keep your follow up questions in the original thread
rather than reposting.

Use the VBE help files to discover what .End and .CurrentRegion do and
then experiment with the sample code. (You can search "End" and
"CurrentRegion"). This should get you started with what you are
looking to do.

Matt Herbert

 

[Joel]

Warning! You i and c will contain all the rows from 7 to 65536 if you data is
only 1 row.

Sub ABC()
Dim cell As Range, c As Range
Dim i As Range, rw As Long
Dim sh As Worksheet
With Worksheets("List")
Set c = .Range(.Cells(6, "B"), .Cells(6, "B").End(xlDown))
Set i = .Range(.Cells(6, "I"), .Cells(6, "I").End(xlDown))
End With

Set sh = Worksheets("Data")
LastRow = sh.cells(rows.count,rw).end(xlup).row
NewRow = LastRow + 1
For Each cell In c
If Application.CountIf(i, cell) > 0 Then
Range(cell, Cells(cell.Row, "G")).Copy sh.Cells(NewRow, 1)

NewRow = NewRow + 1
End If
Next
End Sub

 

[J.W. Aldridge]

Thanx....


But getting

Application defined error or object defined error

on this line

LastRow = sh.Cells(Rows.Count, rw).End(xlUp).Row

 

[Joel]

rw was set to to so I originally used rw and then took out all the lines with
rw except this one

from
LastRow = sh.cells(rows.count,rw).end(xlup).row
to
LastRow = sh.cells(rows.count,"B").end(xlup).row

 

[J.W. Aldridge]

worked purfectly!


Thanx...

When I become a millionaire, I'm buying you a Krystal! With Cheese!
(Or a White Castle).

 

[J.W. Aldridge]

Keep getting error with this part.....


Range(cell, Cells(cell.Row, "g)).Copy sh.Cells(NewRow, 1)

 

[Joel]

You change the B to a G and lost a double quote.

from
Range(cell, Cells(cell.Row, "g)).Copy sh.Cells(NewRow, 1)
to
Range(cell, Cells(cell.Row, "g")).Copy sh.Cells(NewRow, 1)

PS: I've been eating white castle for 50 years. I can eat a lot of those
small burgers.