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.