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
|
Similar Threads
