SHEETLERİ BİR SHEET'TE

[BLUESEA]

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]

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]

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]

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:

[ALPEN]

BEN PEK BİR SORUN GÃ?REMİYORUM.