Marco help! One macro for multiple row tasks Solved/Closed

Question

Hello,

I have two separate workbooks that I need to compare.  Task at hand is I have to find specific text in workbook 2 (col A) and once found  - I then have to copy the next two cells/rows (col B and C) and paste it in wkbook 1 (col B and C) for each individual row for the text found.  The ones that are not found, can be left alone or blank.  

Is that even possible?

Thank you for your help.

rizvisa1 · Answer

Dim mySearchText As String
Dim wb1, wb2 As Workbook
Dim sh1, sh2 As Sheets

Set wb1 = Workbooks("Book1")
Set wb2 = Workbooks("Book2")

Do While True
mySearchText = InputBox("Enter Text to Search For. Enter blank to quit operation.", "Search for")

If (mySearchText = "") Then Exit Sub


wb2.Activate
wb2BRow = Cells(65536, 2).End(xlUp).Row
wb2CRow = Cells(65536, 3).End(xlUp).Row
If (wb2BRow > wb2CRow) Then
    wb2row = wb2BRow
Else
    wb2row = wb2CRow
End If

If wb2row = 1 Then wb2row = 2

    
wb1.Activate

On Error Resume Next

    If ActiveSheet.AutoFilterMode Then
        Cells.Select
        Selection.AutoFilter
    End If
    
    If ActiveSheet.AutoFilterMode = False Then
       Rows(1).Select
        Selection.AutoFilter
    End If
    
On Error GoTo 0

 Selection.AutoFilter Field:=1, Criteria1:="=" & mySearchText, Operator:=xlAnd
 Dim lastRow As Long
 lastRow = Cells(65536, 1).End(xlUp).Row
 
 If (lastRow > 1) Then
 
    Range(Cells(2, 2), Cells(lastRow, 3)).Select
    Selection.Copy
    wb2.Activate
    Cells(wb2row, 2).Select
    Selection.PasteSpecial
    
    wb2BRow = Cells(65536, 2).End(xlUp).Row
    wb2CRow = Cells(65536, 3).End(xlUp).Row
    If (wb2BRow > wb2CRow) Then
        wb2row = wb2BRow
    Else
        wb2row = wb2CRow
    End If
    wb2row = wb2row + 1
  End If
  Loop

Marco help! One macro for multiple row tasks

1 response

Similar discussions

Subscribe To Our Newsletter!