• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

makro düzenleme

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
 

Ekli dosyalar

Kırmızı yeri istediğiniz sayfa adına göre değiştirin.

Kod:
Set s1 = ThisWorkbook.Worksheets("[COLOR="red"]Sayfa1[/COLOR]")
 
Kırmızı yeri istediğiniz sayfa adına göre değiştirin.

Kod:
Set s1 = ThisWorkbook.Worksheets("[COLOR="red"]Sayfa1[/COLOR]")

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("Sayfa2")
buradaki sayfayı diyorsanız, değiştirdiğim de makro hiç işlem yapmadan, işlem tamamlandı mesajı veriyor.

SORUN ÇÖZÜLDÜ
 
Son düzenleme:
Diğer Sayfa1 yazan yerleri de değiştirip denedinizmi?
Pc arızalı olduğundan fazla yardımcı olamıyorum.
 
Geri
Üst