Verileri ana sheet e toplamak

[rekkezum]

çok acil yardım lazım arkadaşlar...

 

[Levent Menteşoğlu]

Butonlara bağlı kodlar ile "genel liste" sayfasındaki sütunlar uyumlu değil. Sayfa üzerinde sütun kaydırmış olabilirsiniz. Örneğin 1.AKTAR butonundaki kod aşağıdaki gibi. Bu kodda kırmızı renkle gösterdiğim "D" sütunü bana "E" sütunun olması gerekiyor gibi geldi.

Sub yesili_aktar()
   Application.ScreenUpdating = False
   Sheets("1").Select
   Range("A9:S51").Select
    Selection.ClearContents
    Range("A9").Select
    Sheets("Genel Liste").Select
    Dim X As Long, SATIR As Long
    
    For X = 6 To [A65536].End(3).Row
    If WorksheetFunction.CountIf([Y9:Y59], Cells(X, "[B][COLOR=red]D[/COLOR][/B]")) > 0 Then
    SATIR = Sheets("1").Range("D65536").End(3).Row + 1
    If SATIR < 9 Then SATIR = 9
    Sheets("1").Range("A" & SATIR & ":S" & SATIR).Value = Range(Cells(X, "A"), Cells(X, "S")).Value
    End If
    Next
    
End Sub

 

[rekkezum]

Butonlara bağlı kodlar ile "genel liste" sayfasındaki sütunlar uyumlu değil. Sayfa üzerinde sütun kaydırmış olabilirsiniz. Örneğin 1.AKTAR butonundaki kod aşağıdaki gibi. Bu kodda kırmızı renkle gösterdiğim "D" sütunü bana "E" sütunun olması gerekiyor gibi geldi.

Sub yesili_aktar()
   Application.ScreenUpdating = False
   Sheets("1").Select
   Range("A9:S51").Select
    Selection.ClearContents
    Range("A9").Select
    Sheets("Genel Liste").Select
    Dim X As Long, SATIR As Long
    
    For X = 6 To [A65536].End(3).Row
    If WorksheetFunction.CountIf([Y9:Y59], Cells(X, "[B][COLOR=red]D[/COLOR][/B]")) > 0 Then
    SATIR = Sheets("1").Range("D65536").End(3).Row + 1
    If SATIR < 9 Then SATIR = 9
    Sheets("1").Range("A" & SATIR & ":S" & SATIR).Value = Range(Cells(X, "A"), Cells(X, "S")).Value
    End If
    Next

    
End Sub

üstadım ek i inceleyebilirmisin acaba ?