Private Sub CommandButton1_Click()
Application.ScreenUpdating = 0
Dim Tablo(), Plg1, Plg2, k, C
Set Plg1 = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Set Plg2 = Range(Cells(2, 3), Cells(Rows.Count, 3).End(xlUp))
For Each C In Plg1
Set k = Plg2.Find(C.Value, lookat:=xlPart)
If Not k Is Nothing Then
TabloCol = TabloCol + 1
ReDim Preserve Tablo(1 To 3, 1 To TabloCol)
Tablo(1, TabloCol) = Format(C.Value, "m/d/yyyy")
Tablo(2, TabloCol) = C.Offset(0, 1)
Tablo(3, TabloCol) = k.Offset(0, 1).Value
End If
Next C
Range(Cells(2, 6), Cells(Rows.Count, 8).End(xlDown)).ClearContents
Cells(2, 6).Resize(UBound(Tablo, 2), UBound(Tablo, 1)) = Application.Transpose(Tablo)
Application.ScreenUpdating = 1
End Sub