Comparer des plages et copier une ligne entière, lorsque certaines cellules correspondent?

Question

Je voudrais comparer 2 plages dans 2 feuilles différentes.

Sheet1("Raport")Sheet1("Raport") contient des informations non détaillées sur les clients et les types de produits qu'ils devraient obtenir.
Sheet2("Dane") contient des informations détaillées sur les clients, ce qui devrait (comme 1 client = toute la ligne) soit copiée dans des feuilles spécifiques (par exemple Sheet3("Produkt1"), Sheet4("Produkt2") etc, en fonction des clients et des produits liste (Sheet1("Raport")).

Suppression des lignes vides (travaux)

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 

Gamme de Produkt1 (travaux)

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 

Gamme de Produkt2 (travaux)Que dois-je écrire à "If" pour comparer des feuilles et copier des informations détaillées sur les clients sur une autre feuille?

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 

En pièce jointe, il y a un fichier avec des résultats finaux (informations client détaillées sont simplement copiées dans les feuilles Produkt1 et Produkt2 sans utiliser des macros). ->https://uploadfiles.io/ttmck

Answer 1

Après avoir copié plage souhaitée avec

range2.EntireRow.Copy 

ligne suivante devrait être coller:

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

avec votre Worksheets(1) remplacer la destination. Cela placera toutes les lignes copiées à des rangées consécutives sur la feuille de destination, vous devrez probablement ajouter RemoveDuplicates à cette gamme finalement.