简体   繁体   中英

Comparing ranges and copy entire row, when some cells match?

I'd like to compare 2 ranges in 2 different sheets.

Sheet1("Raport") contains undetailed customer information and types of product they should get.
Sheet2("Dane") contains detailed information about customers, which should (as 1 customer = entire row) be copied into specific sheets (eg Sheet3("Produkt1") , Sheet4("Produkt2") etc, based on customers and products list ( Sheet1("Raport") ).

Deleting the empty rows (works)

Sub DeleteBlankRows1()
    Dim i As Long

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False

        For i = Selection.Rows.Count To 1 Step -1
            If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
                Selection.Rows(i).EntireRow.Delete
            End If
        Next i

        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Range of Produkt1 (works)

Sub SelectBetween()
    Dim findrow As Long, findrow2 As Long

    findrow = Range("B:B").Find("Produkt1", Range("B1")).Row
    findrow2 = Range("B:B").Find("Laczna ilosc Produkt1", Range("B" & findrow)).Row
    Range("B" & findrow + 1 & ":M" & findrow2 - 1).Select
End Sub

Range of Produkt2 (works)

Sub SelectBetween2()
    Dim findrow As Long, findrow2 As Long

    findrow = Range("B:B").Find("Produkt2", Range("B1")).Row
    findrow2 = Range("B:B").Find("Laczna ilosc Produkt2", Range("B" & findrow)).Row
    Range("B" & findrow + 1 & ":M" & findrow2 - 1).Select
End Sub

What should I write at "If" to compare sheets and copy detailed customer info to another sheet?

Sub Compare()
    Dim w1 As Worksheet, w2 As Worksheet, w3 As Worksheet
    Dim findrow1 As Long, findrow2 As Long
    Dim range1 As Range, range2 As Range, c As Range

    Set w1 = Worksheets("Raport")
    Set w2 = Worksheets("Dane")
    Set w3 = Worksheets("Produkt1")

    findrow1 = w1.Range("B:B").Find("Produkt2", w1.Range("B1")).Row
    findrow2 = w1.Range("B:B").Find("Laczna ilosc Produkt2", w1.Range("B" & findrow1)).Row
    Set range1 = w1.Range("B" & findrow1 + 1 & ":M" & findrow2 - 1)
    Set range2 = w2.Range("2:137")

    If range1 = w2.range2 Then
        range2.EntireRow.Copy w3.Cells(Rows.Count, 1).End(xlUp)(2)
    End If
End Sub

In attachment there's a file with final results (detailed customer info is simply copied in Produkt1 and Produkt2 Sheets without using macros). -> https://uploadfiles.io/ttmck

After you copied desired range with

range2.EntireRow.Copy

next line should be pasting:

Worksheets(1).Paste Destination:=Worksheets(1).Cells(Rows.Count, 1).End(xlUp)(2, 1)

replace Worksheets(1) with your destination. This will place all copied rows to consecutive rows on destination sheet, you will probably need to aply RemoveDuplicates to that range finally.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM