verileri tek sayfaya aktarmada....

[teknikyapı]

Merhaba.Daha önce sn COST_CONTROL arkadaşımın çözmüş olduğu problemimde tekrar bir sorum olacak.Kodları bir türlü çözemedim.Aktarma yapılan sayfada -miktar -birim fiyat ve -tutarı kısmını bir türlü aktaramadım.Birde kodlar yazılırken sayfa sayısı baz almadan kodlara sayfa ismini yazarak çözüm yapılabilirmi.Çünkü benim excel kitabımda bundan başka daha başka konu ile ilgili sayfalar var.Aktarma yaparken onlarıda alıyor.Yani karıştı ortalık :yardim: İnşallah anlatabilmişimdir.Saygılar.İyi çalışmalar

 

[teknikyapı]

Arkadaşlar en ufak bir fikri olan yokmu acaba.?

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Uygulanan kod;

Sub AKTAR()
    Set WF = WorksheetFunction
    Set STT = Sheets("TOPLAM-TÜRKİYE")
    SAYFALAR = Array("İZMİR", "İSTANBUL", "ANKARA", "ADANA")
    STT.[A3:G65536].Clear
    For X = 0 To 3
    If Sheets(SAYFALAR(X)).[A3] <> "" Then
    SATIR1 = STT.[A65536].End(3).Row + 1
    SATIR2 = SATIR1 + Sheets(SAYFALAR(X)).[A65536].End(3).Row - 3
    STT.Range("A" & SATIR1 & ":G" & SATIR2).Value = Sheets(SAYFALAR(X)).Range("A3:G" & SATIR2).Value
    End If
    Next
    For Y = 3 To STT.[A65536].End(3).Row
    STT.Cells(Y, 5) = WF.SumIf(STT.Range("C" & Y & ":C65536"), STT.Cells(Y, 3), STT.Range("E" & Y & ":E65536"))
    STT.Cells(Y, 7) = WF.SumIf(STT.Range("C" & Y & ":C65536"), STT.Cells(Y, 3), STT.Range("G" & Y & ":G65536"))
    STT.Cells(Y, 6) = STT.Cells(Y, 7) / STT.Cells(Y, 5)
    Next
    For Z = STT.[A65536].End(3).Row To 2 Step -1
    If WF.CountIf(STT.Range("B1:B" & Z), Cells(Z, 2)) > 1 Then Rows(Z).Delete
    Next
    If STT.[A3] = "" Then GoTo SON
    If STT.[A4] = "" Then
    STT.[A3] = 1
    GoTo MESAJ
    ElseIf STT.[A5] = "" Then
    STT.[A3] = 1: STT.[A4] = 2
    GoTo MESAJ
    Else
    STT.[A3] = 1: STT.[A4] = 2
    STT.[A3:A4].AutoFill Destination:=Range("A3:A" & STT.[B65536].End(3).Row), Type:=xlFillDefault
MESAJ:
    STT.[G65536].End(3).Offset(1, 0).Font.Bold = True
    STT.[G65536].End(3).Offset(1, 0) = WF.Sum(STT.Range("G2:G" & STT.[G65536].End(3).Row))
    MsgBox "VERİLER AKTARILMIŞTIR.", vbInformation
    End If
    Exit Sub
SON: MsgBox "AKTARILACAK VERİ BULUNAMAMIŞTIR.", vbExclamation
End Sub

 

[teknikyapı]

Çok teşekkür ederim sn COST_CONTROL.İyi çalışmalar