SHEETLERİ BİR SHEET'TE

[BLUESEA]

SHEETLERÝ BÝR SHEET'TE

SELAM,

DÜN SORDUÐUM SORU İÇİN ÇOK ÜZÜLDÜM. BEN SADECE HAZIRLADIÐIM BİR TABLONUN KOLAYLIKLA BİRLEÞMESİNİ İSTEMİÞTİM. AMA SONUÇ BENİ ÜZDÜ. CEVAP VEREN TÜM ARKADAÞLARA TEÞEKKÜR EDERİM.

BU ARADA DERYA ARKADAÞIMIN GÃ?NDERDİÃİ MAKRO ÇALIÞMIYOR. EÐER YARDIMCI OLMAK İSTEYEN VARSA LÜTFEN BANA YAZSIN. İNÞALLAH YENİ BİR KAOS'A YOL AÇMAM

ÞİMDİDEN TEÞEKKÜR EDERİM

SAYGILARIMLA

 

[ALPEN]

verdiği hatayı nerede verdiğini yazarsan daha çabuk yardımcı olunur.

 

[dolphin]

şimdi yakaladım alpen seni. senin gibi cevap vereceğim. belki birilerinin ahı tutmuştur :hiho: :hiho: :hiho: bir kere ben 13 yaşın altında değilim. senden küçük olabilirim ama yinede :icelim:

 

[BLUESEA]

SHEETLERÝ BÝR SHEETE TOPLAMAK

SELAM,

HAZIRLADIÐIM ÇALIÞMA KİTABINI KISACA Ã?ZETLEYEYİM.

27 SHEET'TEN OLUÞAN BİR ÇALIÞMA KİTABIM VAR.
BUNUN;
1. SHEET'İNE İCMAL ADINI VERDİM BU SHEETİN 1. VE 2. SATIRI BAÞLIK İÇERİYOR.
2. SHEET'İNE DÃ?KÜM ADINI VERDİM. BU SAYFADA DİÐER 25 SAYFANIN BELLİ SÜTUN ALT TOPLAMLARI ALINIYOR.

GELELİM ESAS MESELEYE;

BEN 3. SHEET'TEN İTİBAREN HER SHEET'E BİR FİRMA İSMİ VERDİM VE BU SHEETLERDEKİ 3. SATIRDAN İTİBAREN TÜM KOLONLARIN 1. SHEET'E 3. SATIRINDAN BAÞLAMAK ÜZERE SIRALANMASINI İSTİYORUM

İKİNCİSİ İSE, BU 1. SHEETTEKİ DÃ?KÜMDEN SONRA TARİHLERİ BU GÜNDEN ESKİ OLAN SATIRLAR (TARİH Q SÜTUNUNDA) KIRMIZI RENGE DÃ?NÜÞSÜN

İNÞALLAH FAZLA BİRÞEY İSTEMİYORUMDUR.

SAYGILAR

 

[ALPEN]

Sub topla_getir()
    Dim sayfa As Worksheet
    Dim sonsatir As Long
    Dim son As Long
        ilk = True
        On Error Resume Next
        For Each sayfa In ThisWorkbook.Worksheets
            If sayfa.Name <> "İCMAL" And sayfa.Name <> "DÃ?KÜM" Then
                If ilk = True Then
                    son = 2
                    ilk = False
                Else
                    son = Worksheets("İCMAL").Cells.Find(What:="*", After:=Worksheets("İCMAL").Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
                End If
                sonsatir = sayfa.Cells.Find(What:="*", After:=sayfa.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
                sayfa.Range(sayfa.Rows(3), sayfa.Rows(sonsatir)).Copy Sheets("İCMAL").Cells(son + 1, "A")
            End If
        Next
End Sub

kisaca ne yapar.

İCMAL ve DÃ?KÜM haricindeki tum sayfaların ucuncu satırından ıtıbaren veri olan son satirina kadar olan satirlari İCMAL sayfasına ucuncu satırdan itibaren alt alta kopyalar.

Not: Daha kısasını yazacak olanı vallahı doverım. 3 kadeh rakıya mal oldu. veya dovmem ama 4 kadeh raki ismarlatirim.

Edit : excel'de yaptıktan sonra buraya yapıştırırken büyük "i" harfinin sapıtması üzerine (İ harfi buraya yapıştırdıktan sonra &yws gibi bir şey oldu) manual burada elle değiştirirken yukarıdaki" karakteride yanlışlıkla silinmiş, eklendi.

Edit2: eööh code taglarının içine sanırım color tag'ı verilemiyor. onun için normal düzeltildi.

 

[dolphin]

Sub topla_getir()
    Dim sy As Worksheet
    Dim ss As Long
    Dim sn As Long
        i = True
        On Error Resume Next
        For Each sy In ThisWorkbook.Worksheets
            If sy.Name <> İCMAL" And sy.Name <> "DÃ?KÜM" Then
                If i = True Then
                    sn = 2
                    i = False
                Else
                    sn = Worksheets("İCMAL").Cells.Find(What:="*", After:=Worksheets("İCMAL").Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
                End If
                ss = sy.Cells.Find(What:="*", After:=sy.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
                sy.Range(sy.Rows(3), sy.Rows(ss)).Copy Sheets("İCMAL").Cells(sn + 1, "A")
            End If
        Next
End Sub

İşte kısaltılmış kod. ALPEN abi 4 değil 4x4 kadeh feda olsun sana :hihoho:

 

[ALPEN]

pek kisaltma (parametreler disinda) goremesemde kodu denemis olman guzel.

 

[BLUESEA]

SHEET'leri bir sheette toplamak

ARKADAÞLAR İLGİNİZ İÇİN TEÞEKKÜR EDERİM,

ANCAK BU DÃ?NGÜ SADECE 4. SHEET'İ TAÞIYOR. DİÐER SHEETLERİ TAÞIMIYOR. TEK TEK SHEETLERİN ADINI MI GİRMEM GEREKİYOR ACABA..

SAYGILARIMLA,

 

[BLUESEA]

SHEET'leri bir sheette toplamak

ARKADAÞLAR HERÞEY İÇİN ÇOK AMA ÇOK TEÞEKKÜR EDERİM.
ÞİMDİ OLDU. SÜPERSİNİZ.

SİZE 70'LİK BORCUM VAR... :hihoho: