View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
climate climate is offline
external usenet poster
 
Posts: 91
Default copy several rows

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