Sayfa Bakiye Bilgisini İcmale Alma

[obsesyonur]

Merhaba,örnek dosyamda, icmal sayfasında el ile oluşturulan tabloyu komut butonuna yazılacak kodlar ile otomatik olarak yaptırabilir miyim?
Herkese iyi çalışmalar.

[SNNAY]

Aşağıdaki kodlar işinizi görecektir.

Kod: Tümünü seç

Sub VeriKopyala()
    Dim ws As Worksheet
    Dim icmal As Worksheet
    Dim lastRow As Long
    Dim lastDate As Date
    Dim lastQuantity As Double
    Dim sheetNames() As String
    Dim i As Integer, j As Integer
    
    Set icmal = ThisWorkbook.Sheets("İCMAL")
    icmal.Range("A2:C" & icmal.Cells(icmal.Rows.Count, "A").End(xlUp).Row).ClearContents 'İCMAL sayfasındaki eski verileri temizle
    
    'Sayfa adlarını al ve sırala
    j = 0
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "İCMAL" Then
            ReDim Preserve sheetNames(j)
            sheetNames(j) = ws.Name
            j = j + 1
        End If
    Next ws
    ' Sırala
    For i = LBound(sheetNames) To UBound(sheetNames) - 1
        For j = i + 1 To UBound(sheetNames)
            If sheetNames(i) > sheetNames(j) Then
                Dim temp As String
                temp = sheetNames(i)
                sheetNames(i) = sheetNames(j)
                sheetNames(j) = temp
            End If
        Next j
    Next i
    'Sıralanmış sayfa adlarını A2:A aralığına yaz
    For i = LBound(sheetNames) To UBound(sheetNames)
        icmal.Cells(i + 2, 1).Value = sheetNames(i)
    Next i
    
    'Her sayfadaki son tarihi ve miktarı İCMAL sayfasına yaz
    For i = 2 To icmal.Cells(icmal.Rows.Count, "A").End(xlUp).Row
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name = icmal.Cells(i, 1).Value Then
                lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                lastDate = ws.Cells(lastRow, "A").Value
                lastQuantity = ws.Cells(lastRow, "F").Value
                icmal.Cells(i, 2).Value = lastDate
                icmal.Cells(i, 3).Value = lastQuantity
                Exit For
            End If
        Next ws
    Next i
End Sub

[obsesyonur]

Sayın @SNNAY,
Göndermiş olduğunuz kod bloğu gayet güzel bir şekilde çalışmaktadır.İlginiz için teşekkür eder,iyi çalışmalar dilerim.