- Katılım
- 5 Eylül 2007
- Mesajlar
- 1,247
- Excel Vers. ve Dili
- ofis 2010
iyi günler, kullanmakta olduğum makroda raporlama kısmını sayfa2 ' ye almak istiyorum. Yapamadım.
Kod:
Sub işlem()
Application.ScreenUpdating = False
On Error Resume Next
Range("e2:l65536").ClearContents
Range("a2:d65536").Interior.ColorIndex = 0
Set s1 = ThisWorkbook.Worksheets("Sayfa1")
For i = 2 To s1.Range("A65536").End(xlUp).Row
sonsatir = s1.Range("e65536").End(xlUp).Row + 1
s1.Cells(sonsatir, "e") = s1.Cells(i, 1) & s1.Cells(i, 2)
Next i
For k = 2 To s1.Range("c65536").End(xlUp).Row
sonsatir1 = s1.Range("f65536").End(xlUp).Row + 1
s1.Cells(sonsatir1, "f") = s1.Cells(k, 3) & s1.Cells(k, 4)
Next k
For i = 2 To s1.Range("e65536").End(xlUp).Row
sonsatir1 = s1.Range("g65536").End(xlUp).Row + 1
s1.Cells(sonsatir1, "g") = s1.Cells(i, "e") & WorksheetFunction.CountIf(Sheets("sayfa1").Range("e2:e" & i), Sheets("sayfa1").Cells(i, "e"))
Next i
For i = 2 To s1.Range("f65536").End(xlUp).Row
sonsatir1 = s1.Range("h65536").End(xlUp).Row + 1
s1.Cells(sonsatir1, "h") = s1.Cells(i, "f") & WorksheetFunction.CountIf(Sheets("sayfa1").Range("f2:f" & i), Sheets("sayfa1").Cells(i, "f"))
Next i
For i = 2 To s1.Range("g65536").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("sayfa1").Range("h2:h65536"), Sheets("sayfa1").Cells(i, "g")) = 0 Then
sonsatir = s1.Range("ı65536").End(xlUp).Row + 1
s1.Cells(sonsatir, "ı") = s1.Cells(i, 1)
s1.Cells(sonsatir, "j") = s1.Cells(i, 2)
s1.Cells(i, 1).Interior.ColorIndex = 8
End If
Next i
For i = 2 To s1.Range("h65536").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("sayfa1").Range("g2:g65536"), Sheets("sayfa1").Cells(i, "h")) = 0 Then
sonsatir = s1.Range("k65536").End(xlUp).Row + 1
s1.Cells(sonsatir, "k") = s1.Cells(i, 3)
s1.Cells(sonsatir, "l") = s1.Cells(i, 4)
s1.Cells(i, 3).Interior.ColorIndex = 6
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub
