Dear experts
I have following code that Jacob has written(very thank's for his help). by
using this code, i can copy only one row to sheet2 based on value of column
G.i need to a macro which able to copy several rows to sheet2.in other words,
when i run macro and open the box for input, take it at least 30 values, and
then copy related rows to sheet2.column G has 4500 cells.

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim varFound As Variant, varSearch As Variant
Dim strAddress As String, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet

varSearch = InputBox("Find which number in row G and copy it?")
If varSearch = "" Then Exit Sub

With ws1.Columns("G")
Set varFound = .Find(varSearch, LookIn:=xlValues, LookAt:=xlWhole)
If Not varFound Is Nothing Then
strAddress = varFound.Address
Do
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(varFound.Row).Copy ws2.Rows(lngLastRow)
Set varFound = .FindNext(varFound)
Loop While Not varFound Is Nothing And _
varFound.Address < strAddress
End If
End With
End Sub

Any help will be greatly appreciating.

regards

Hi ..Try the below code....The search items are mentioned in a range in
Sheet3 range A1:A0...Change to suit

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub

--
Jacob (MVP - Excel)


"climate" wrote:

Dear experts
I have following code that Jacob has written(very thank's for his help). by
using this code, i can copy only one row to sheet2 based on value of column
G.i need to a macro which able to copy several rows to sheet2.in other words,
when i run macro and open the box for input, take it at least 30 values, and
then copy related rows to sheet2.column G has 4500 cells.

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim varFound As Variant, varSearch As Variant
Dim strAddress As String, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet

varSearch = InputBox("Find which number in row G and copy it?")
If varSearch = "" Then Exit Sub

With ws1.Columns("G")
Set varFound = .Find(varSearch, LookIn:=xlValues, LookAt:=xlWhole)
If Not varFound Is Nothing Then
strAddress = varFound.Address
Do
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(varFound.Row).Copy ws2.Rows(lngLastRow)
Set varFound = .FindNext(varFound)
Loop While Not varFound Is Nothing And _
varFound.Address < strAddress
End If
End With
End Sub

Any help will be greatly appreciating.

regards

Correction...

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If ws1.Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, ws1.Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub


--
Jacob (MVP - Excel)


"Jacob Skaria" wrote:

Hi ..Try the below code....The search items are mentioned in a range in
Sheet3 range A1:A0...Change to suit

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub

--
Jacob (MVP - Excel)


"climate" wrote:

Dear experts
I have following code that Jacob has written(very thank's for his help). by
using this code, i can copy only one row to sheet2 based on value of column
G.i need to a macro which able to copy several rows to sheet2.in other words,
when i run macro and open the box for input, take it at least 30 values, and
then copy related rows to sheet2.column G has 4500 cells.

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim varFound As Variant, varSearch As Variant
Dim strAddress As String, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet

varSearch = InputBox("Find which number in row G and copy it?")
If varSearch = "" Then Exit Sub

With ws1.Columns("G")
Set varFound = .Find(varSearch, LookIn:=xlValues, LookAt:=xlWhole)
If Not varFound Is Nothing Then
strAddress = varFound.Address
Do
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(varFound.Row).Copy ws2.Rows(lngLastRow)
Set varFound = .FindNext(varFound)
Loop While Not varFound Is Nothing And _
varFound.Address < strAddress
End If
End With
End Sub

Any help will be greatly appreciating.

regards

Hi
Your code hasn't reaction, box for input (desired value of ColG) not open,
and what is the cause for sheet3?

regards

"Jacob Skaria" wrote:

Correction...

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If ws1.Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, ws1.Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub


--
Jacob (MVP - Excel)


"Jacob Skaria" wrote:

Hi ..Try the below code....The search items are mentioned in a range in
Sheet3 range A1:A0...Change to suit

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub

--
Jacob (MVP - Excel)


"climate" wrote:

Dear experts
I have following code that Jacob has written(very thank's for his help). by
using this code, i can copy only one row to sheet2 based on value of column
G.i need to a macro which able to copy several rows to sheet2.in other words,
when i run macro and open the box for input, take it at least 30 values, and
then copy related rows to sheet2.column G has 4500 cells.

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim varFound As Variant, varSearch As Variant
Dim strAddress As String, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet

varSearch = InputBox("Find which number in row G and copy it?")
If varSearch = "" Then Exit Sub

With ws1.Columns("G")
Set varFound = .Find(varSearch, LookIn:=xlValues, LookAt:=xlWhole)
If Not varFound Is Nothing Then
strAddress = varFound.Address
Do
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(varFound.Row).Copy ws2.Rows(lngLastRow)
Set varFound = .FindNext(varFound)
Loop While Not varFound Is Nothing And _
varFound.Address < strAddress
End If
End With
End Sub

Any help will be greatly appreciating.

regards

Instead of having inputbox's for entering multiple values; you can type in
those values to a different range...I have put that as Sheet3 A1:A10...This
could be changed to another locaiton to suit...

--
Jacob (MVP - Excel)


"climate" wrote:

Hi
Your code hasn't reaction, box for input (desired value of ColG) not open,
and what is the cause for sheet3?

regards

"Jacob Skaria" wrote:

Correction...

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If ws1.Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, ws1.Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub


--
Jacob (MVP - Excel)


"Jacob Skaria" wrote:

Hi ..Try the below code....The search items are mentioned in a range in
Sheet3 range A1:A0...Change to suit

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub

--
Jacob (MVP - Excel)


"climate" wrote:

Dear experts
I have following code that Jacob has written(very thank's for his help). by
using this code, i can copy only one row to sheet2 based on value of column
G.i need to a macro which able to copy several rows to sheet2.in other words,
when i run macro and open the box for input, take it at least 30 values, and
then copy related rows to sheet2.column G has 4500 cells.

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim varFound As Variant, varSearch As Variant
Dim strAddress As String, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet

varSearch = InputBox("Find which number in row G and copy it?")
If varSearch = "" Then Exit Sub

With ws1.Columns("G")
Set varFound = .Find(varSearch, LookIn:=xlValues, LookAt:=xlWhole)
If Not varFound Is Nothing Then
strAddress = varFound.Address
Do
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(varFound.Row).Copy ws2.Rows(lngLastRow)
Set varFound = .FindNext(varFound)
Loop While Not varFound Is Nothing And _
varFound.Address < strAddress
End If
End With
End Sub

Any help will be greatly appreciating.

regards

I thought its a better solution to mention the items in a range than using
Inputbox multiple times.. Sheet3 is just an example. You can change that to
suit..

--
Jacob (MVP - Excel)


"climate" wrote:

Hi
Your code hasn't reaction, box for input (desired value of ColG) not open,
and what is the cause for sheet3?

regards

"Jacob Skaria" wrote:

Correction...

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If ws1.Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, ws1.Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub


--
Jacob (MVP - Excel)


"Jacob Skaria" wrote:

Hi ..Try the below code....The search items are mentioned in a range in
Sheet3 range A1:A0...Change to suit

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub

--
Jacob (MVP - Excel)


"climate" wrote:

Dear experts
I have following code that Jacob has written(very thank's for his help). by
using this code, i can copy only one row to sheet2 based on value of column
G.i need to a macro which able to copy several rows to sheet2.in other words,
when i run macro and open the box for input, take it at least 30 values, and
then copy related rows to sheet2.column G has 4500 cells.

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim varFound As Variant, varSearch As Variant
Dim strAddress As String, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet

varSearch = InputBox("Find which number in row G and copy it?")
If varSearch = "" Then Exit Sub

With ws1.Columns("G")
Set varFound = .Find(varSearch, LookIn:=xlValues, LookAt:=xlWhole)
If Not varFound Is Nothing Then
strAddress = varFound.Address
Do
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(varFound.Row).Copy ws2.Rows(lngLastRow)
Set varFound = .FindNext(varFound)
Loop While Not varFound Is Nothing And _
varFound.Address < strAddress
End If
End With
End Sub

Any help will be greatly appreciating.

regards

Hello Jacob
You are right, i understand your means.
Your macro work's correctly and is very very nice.
Many thank's for you, your help stayed in my mind.
Best wishes
regards

"Jacob Skaria" wrote:

I thought its a better solution to mention the items in a range than using
Inputbox multiple times.. Sheet3 is just an example. You can change that to
suit..

--
Jacob (MVP - Excel)


"climate" wrote:

Hi
Your code hasn't reaction, box for input (desired value of ColG) not open,
and what is the cause for sheet3?

regards

"Jacob Skaria" wrote:

Correction...

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If ws1.Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, ws1.Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub


--
Jacob (MVP - Excel)


"Jacob Skaria" wrote:

Hi ..Try the below code....The search items are mentioned in a range in
Sheet3 range A1:A0...Change to suit

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub

--
Jacob (MVP - Excel)


"climate" wrote:

Dear experts
I have following code that Jacob has written(very thank's for his help). by
using this code, i can copy only one row to sheet2 based on value of column
G.i need to a macro which able to copy several rows to sheet2.in other words,
when i run macro and open the box for input, take it at least 30 values, and
then copy related rows to sheet2.column G has 4500 cells.

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim varFound As Variant, varSearch As Variant
Dim strAddress As String, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet

varSearch = InputBox("Find which number in row G and copy it?")
If varSearch = "" Then Exit Sub

With ws1.Columns("G")
Set varFound = .Find(varSearch, LookIn:=xlValues, LookAt:=xlWhole)
If Not varFound Is Nothing Then
strAddress = varFound.Address
Do
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(varFound.Row).Copy ws2.Rows(lngLastRow)
Set varFound = .FindNext(varFound)
Loop While Not varFound Is Nothing And _
varFound.Address < strAddress
End If
End With
End Sub

Any help will be greatly appreciating.

regards

Hi
I'm sorry,i need to copy A1:A10 on sheet3 just as i enter with it's
arrangment. when i run your code, change arrange of data. would you plesae
complete it.

regards

"Jacob Skaria" wrote:

I thought its a better solution to mention the items in a range than using
Inputbox multiple times.. Sheet3 is just an example. You can change that to
suit..

--
Jacob (MVP - Excel)


"climate" wrote:

Hi
Your code hasn't reaction, box for input (desired value of ColG) not open,
and what is the cause for sheet3?

regards

"Jacob Skaria" wrote:

Correction...

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If ws1.Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, ws1.Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub


--
Jacob (MVP - Excel)


"Jacob Skaria" wrote:

Hi ..Try the below code....The search items are mentioned in a range in
Sheet3 range A1:A0...Change to suit

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngSearch As Range, lngRow As Long, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet
Set rngSearch = Sheets("Sheet3").Range("A1:A10") 'search items

For lngRow = 1 To ws1.Cells(Rows.Count, "G").End(xlUp).Row
If Range("G" & lngRow) < "" Then
If WorksheetFunction.CountIf(rngSearch, Range("G" & lngRow)) < 0 Then
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(lngRow).Copy ws2.Rows(lngLastRow)
End If
End If
Next

End Sub

--
Jacob (MVP - Excel)


"climate" wrote:

Dear experts
I have following code that Jacob has written(very thank's for his help). by
using this code, i can copy only one row to sheet2 based on value of column
G.i need to a macro which able to copy several rows to sheet2.in other words,
when i run macro and open the box for input, take it at least 30 values, and
then copy related rows to sheet2.column G has 4500 cells.

Sub CopyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim varFound As Variant, varSearch As Variant
Dim strAddress As String, lngLastRow As Long

Set ws1 = Sheets("Sheet1") 'source sheet
Set ws2 = Sheets("Sheet2") 'destination sheet

varSearch = InputBox("Find which number in row G and copy it?")
If varSearch = "" Then Exit Sub

With ws1.Columns("G")
Set varFound = .Find(varSearch, LookIn:=xlValues, LookAt:=xlWhole)
If Not varFound Is Nothing Then
strAddress = varFound.Address
Do
lngLastRow = ws2.Cells(Rows.Count, "G").End(xlUp).Row + 1
ws1.Rows(varFound.Row).Copy ws2.Rows(lngLastRow)
Set varFound = .FindNext(varFound)
Loop While Not varFound Is Nothing And _
varFound.Address < strAddress
End If
End With
End Sub

Any help will be greatly appreciating.

regards