Sayfa Bakiye Bilgisini İcmale Alma

Cevapla
obsesyonur
Mesajlar: 4
Kayıt: Çrş May 08, 2024 1:26 am
Adınız: martian
Soyadınız: black

Sayfa Bakiye Bilgisini İcmale Alma

Mesaj gönderen 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.
Bu mesaja eklenen dosyaları görüntülemek için gerekli izinlere sahip değilsiniz.
SNNAY
Mesajlar: 29
Kayıt: Prş Mar 21, 2024 11:31 am
Lokasyon: istanbul
Meslek: Oto Yedek Parça Satış Elemanı
Adınız: Sinan
Soyadınız: Aykaç

Re: Sayfa Bakiye Bilgisini İcmale Alma

Mesaj gönderen 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
Bu mesaja eklenen dosyaları görüntülemek için gerekli izinlere sahip değilsiniz.
obsesyonur
Mesajlar: 4
Kayıt: Çrş May 08, 2024 1:26 am
Adınız: martian
Soyadınız: black

Re: Sayfa Bakiye Bilgisini İcmale Alma

Mesaj gönderen 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.
Cevapla
  • Benzer Konular
    Cevaplar
    Görüntüleme
    Son mesaj