Sekmelerden sonuçlar

[modoste]

merhaba sayın hocalarım ekli dosyamda sorumu ilettim kısaca bahsetmem gerekirse
aynı formattaki sekmelerde (sorumda 3 sekme belirledim) verilmiş bilgileri istek sekmesi altında sanki 3 sekme tek sekme imiş gibi firma1 firma2 ve firma3 sekmelerindeki verileri altalta tek listede yazma ile ile ilgili

sorunun çözümü makro ile de olabilir.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.
Eğer işleme sokmak istemediğiniz sayfa varsa;
If .Name <> Si.Name Then satırına ilave yapabilirsiniz.

Sub Listele()

    Dim Si As Worksheet, i As Integer, son As Long, sat As Long

    Set Si = Sheets("İstek")
    
    Application.ScreenUpdating = False
    Si.Range("B13:I" & Rows.Count).ClearContents 'eğer silmeden-
    'devamına ekleme yapacaksa bu satırı silin.
    
    For i = 1 To Worksheets.Count
        With Sheets(i)
            If .Name <> Si.Name Then
                son = .[A12:G43].Find("*", , , , xlByRows, xlPrevious).Row
                If son > 12 Then
                    sat = Si.[C:I].Find("*", , , , xlByRows, xlPrevious).Row + 1
                    .Range("A13:G" & son).Copy Si.Cells(sat, "C")
                    Si.Cells(sat, "B").Resize(son - 12, 1) = .Name
                End If
            End If
        End With
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "Aktarım Tamamlandı...", , "excel.web.tr"
    
End Sub

 

[modoste]

Sayın Ömer Hocam çözüm için teşekkür ederim
bu çözüm ardından istek değişti yani belirlenen 2 tarih arasında yani her sekmenin A13 hücresinden başlayan ve aşağıya doğru devam eden tarih verilerine göre bir kriter daha getirmem istendi

mesela başlangıç 01.01.2018 olsun bitiş tarihi 02.11.2018 arası olsun bu tarih aralığından hangi sekmede hareket olmuşsa o listelensin

 

[Ömer]

Veri olup tarih olmayan veriler var?

 

[modoste]

veri olup olmaması önemli değil hocam şimdilik sadece beirlediğim 2 tarih arasında her sekmedeki kısımların altalta listelenmesi

 

[Ömer]

Veri olup olmaması neden önemli!

Tarih ölçütü var diyorsunuz, eğer veri alınacak sayfanın ft no, açıklama vs dolu fakat tarih sütunu boş olursa ne olacak? Tarih olmayan bir hücrede tarih ölçütü ne mantıkla çalıştıracağız.?

O yüzden önemli diye düşünmüştüm.

 

[Ömer]

Tarih sütununda veri var mı yok mu kontrolü yapılmadı.

Sub Listele()

    Dim Si As Worksheet, i As Integer, son As Long, sat As Long
    Dim a As Date, b As Date, j As Long

    Set Si = Sheets("İstek")
   
    a = "01.11.2018" 'tarih ölçütü1
    b = "10.11.2018" 'tarih ölçütü2
   
    Application.ScreenUpdating = False
    Si.Range("B13:I" & Rows.Count).ClearContents 'eğer silmeden-
    'devamına ekleme yapacaksa bu satırı silin.
   
    For i = 1 To Worksheets.Count
        With Sheets(i)
            If .Name <> Si.Name Then
                son = .[A12:G43].Find("*", , , , xlByRows, xlPrevious).Row
                For j = 13 To son
                    If .Cells(j, "A") >= a And .Cells(j, "A") <= b Then
                        sat = Si.[C:I].Find("*", , , , xlByRows, xlPrevious).Row + 1
                        .Range("A" & j & ":G" & j).Copy Si.Cells(sat, "C")
                        Si.Cells(sat, "B") = .Name
                    End If
                Next j
            End If
        End With
    Next i
   
    Application.ScreenUpdating = True
    MsgBox "Aktarım Tamamlandı...", , "excel.web.tr"
   
End Sub

 

[modoste]

detaylı bakınca anladım sayın ömer hocam ne demek istediğinizi
şimdi muhasebeci arkadaşımın cari dosyasının geneline bakıp son olarak nasıl bir çözümleme istediğimi söyleyeceğim size

genel olarak ne yapmaya çalıştığımızı anlamışsınızdır ömer hocam
patronumuz diyorki arkadaşıma 1 ekim 18 kasım arasında bak bakalım ne kadar masrafımız olmuş
muhasebedeki arkadaşımın excel carisi ise size attığım dosyadaki firma1 firma2 adları değilde esnafların direk isimleri ile açılmış dosya (Prokent, KAhraman Çelik, Site Bobinaj Gibi) arkadaşım her sekmeye gelip ilgili tarih aralığındaki verileri mouse ile seçip başka bir yere topluyo ordan sonuca gidiyo ben sana yardımcı olayım dedim. size özetini göderdim sorunun.

 

[modoste]

ömer hocam ben size şimdi dosyanın aslını göndericem ve ordan nasıl sonuç alırız diye tekrar değerlendirmenizi isteyecem.
dosyayı ekledim sayın ömer hocam
isteğimi tekrarlarsam belirlenmiş 2 tarih arasında ( tarih yoksa 01.01.2018 alsın) hareket olsan firmaların kısımlarını tek bir listede sıralasın en solunada firmanın adını yazsın

 

[Ömer]

Dosyayı incelemedim, #7 numaralı mesajda yeni kod yazmıştım.
a ve b tarih ölçütlerini kendinize uyarlayıp dener misiniz.

 

[modoste]

arkadaşımın tuttuğu cari hesaplar genelde bu şekilde ben ona daha önce demiştim bu tip yapcaksan formatları aynı olsun yani hepsi aynı satırda başlasın ne bileyim hepsinin tutarları aynı sütunlarda olsun gibi

 

[modoste]

gerçek listeye 7 nolu makroyu yazınca
"object variable or with block variable not set" hatası aldım

 

[modoste]

ömer hocam 7 nolu mesajı uyguladım sonuç aldım makro içine yazılan tarihi İStek Sekmesinden biryere yazarak kendimiz değiştirebilerek yeniden düzenleyebilirmiyiz.

 

[Ömer]

Bu şekilde deneyin.
İstek sayfası, B1 ve B2 hücrelerinden tarih ölçütlerini alır.

Sub Listele()

    Dim Si As Worksheet, i As Integer, son As Long, sat As Long
    Dim a As Date, b As Date, j As Long

    Set Si = Sheets("İstek")
 
    a = Si.Range("B1") 'tarih ölçütü ilk
    b = Si.Range("B2") 'tarih ölçütü son
 
    Application.ScreenUpdating = False
    Si.Range("B13:I" & Rows.Count).ClearContents 'eğer silmeden-
    'devamına ekleme yapacaksanız bu satırı silin.
 
    For i = 1 To Worksheets.Count
        With Sheets(i)
            If .Name <> Si.Name Then
                son = .[A12:G43].Find("*", , , , xlByRows, xlPrevious).Row
                For j = 13 To son
                    If .Cells(j, "A") >= a And .Cells(j, "A") <= b Then
                        sat = Si.[C:I].Find("*", , , , xlByRows, xlPrevious).Row + 1
                        .Range("A" & j & ":G" & j).Copy Si.Cells(sat, "C")
                        Si.Cells(sat, "B") = .Name
                    End If
                Next j
            End If
        End With
    Next i
 
    Application.ScreenUpdating = True
    MsgBox "Aktarım Tamamlandı...", , "excel.web.tr"
 
End Sub

 

[modoste]

hocam birde makroyu butona atama yapabilir miyiz her defasında tarihleri değişip ALT+F8 diyip çalışırıyorum makroyu