Sub UniqueCopy()
Sheet1.Range("1:20").Clear
On Error Resume Next
Sheet2.Select
With ActiveSheet
.Range("A1", .Range("A65536").End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Sheet1.Range("A1"), Unique:=True
End With
On Error GoTo 0
test
End Sub
Sub test()
Dim k As Integer
Z = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
y = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
For I = 2 To Z
k = 2
For j = 2 To y
If LCase(Sheet1.Range("A" & I).Value) = LCase(Sheet2.Range("A" & j).Value) Then
Sheet1.Cells(I, k).Value = Sheet2.Range("b" & j).Value
k = k + 1
Sheet1.Cells(I, k).Value = Sheet2.Range("c" & j).Value
k = k + 1
'Sheet1.Cells(i, k).Value = Sheet2.Range("d" & j).Value'
'k = k + 1'
'Sheet1.Cells(i, k).Value = Sheet2.Range("e" & j).Value'
'k = k + 1'
End If
Next
Next
End Sub
کامنت