excelde sayfaları birleştirme

[WelleTy]

Merhabalar benim bir 20 sayfadan oluşan bir çalışmam var. " H " sütünü içinde sonuç kısmında geçti, kaldı ve hiç değer yazmayan hücreler var. istediğim bu sayfalardaki " H " satırındaki kaldı değerine sahip olamayan bütün " B ve C " sütünlerini tek bir farklı sayfada birleştirmek bunu nasıl yapabilirim

 

[parametre]

Slm örnek dosya taleb ediyoruz acıklamanızı daha anlasılır yazarsanız sonuca ulasmak oldukca kolaylasacaktır saygılar

 

[WelleTy]

Slm örnek dosya taleb ediyoruz acıklamanızı daha anlasılır yazarsanız sonuca ulasmak oldukca kolaylasacaktır saygılar

Örnek olması için bir dosya yükledim dosyada toplamda 4 sayfa var dört sayfa icinde genel toplam sayfası haricindeki bütün sayfalardaki verileri tek bir sayfada toplamak istiyorum ama diğer sayfalardaki " I " sütünündeki kaldı olanların haricinde olan boşlar dahil hepsini oluşturacağımız yeni sayfaya aktarmak istiyorum

 

[numan şamil]

Merhaba
Sayfa1 adlı bir sayfan olsun İstediğiniz kritere uyan verileri bu sayfaya toplamak için
kodları dener misiniz

Sub sayfalarıaktar()
Dim s1, S2, x As Long
Set s1 = Sheets("GENEL TOPLAM")
Set S2 = Sheets("Sayfa1")
 S2.Range("A3:J" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Satır = 3
 For Each SAYFA In Worksheets
 If SAYFA.Name <> "GENEL TOPLAM" And SAYFA.Name <> "Sayfa1" Then
For x = 3 To SAYFA.Cells(Rows.Count, "I").End(3).Row
If SAYFA.Range("I" & x).Value <> "KALDI" Then
S2.Range("A" & Satır).Value = SAYFA.Range("A" & x).Value
S2.Range("B" & Satır).Value = SAYFA.Range("B" & x).Value
S2.Range("C" & Satır).Value = SAYFA.Range("C" & x).Value
S2.Range("D" & Satır).Value = SAYFA.Range("D" & x).Value
S2.Range("E" & Satır).Value = SAYFA.Range("E" & x).Value
S2.Range("F" & Satır).Value = SAYFA.Range("F" & x).Value
S2.Range("G" & Satır).Value = SAYFA.Range("G" & x).Value
S2.Range("H" & Satır).Value = SAYFA.Range("H" & x).Value
S2.Range("I" & Satır).Value = SAYFA.Range("I" & x).Value
S2.Range("J" & Satır).Value = SAYFA.Range("J" & x).Value
Satır = Satır + 1
End If
Next x
End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation, "Numan Şamil"
End Sub

 

[WelleTy]

öncelikle teşekkür ederim ama bir sorun oldu bir sayfada 35 tane satırdan fazlasını cekmiyor mesala bir tanesinde 45 tane satır var o sayfanın sadece 35 tanesini alıyor

 

[numan şamil]

Merhaba
kodların

For x = 3 To SAYFA.Cells(Rows.Count, "I").End(3).Row

kısmını

For x = 3 To SAYFA.Cells(Rows.Count, "A").End(3).Row

Şeklinde değiştirip
Dener misiniz

 

[WelleTy]

tamam hocam cözdüm durumu " I " sutununda bazılarında formul yok diye almıyordu onlarada formul eklemem lazım mış

 

[numan şamil]

kodlarda 6. mesajdaki gibi değişiklik yaparsan sorun kalmaz sanırım

 

[WelleTy]

Merhaba
kodların

For x = 3 To SAYFA.Cells(Rows.Count, "I").End(3).Row

kısmını

For x = 3 To SAYFA.Cells(Rows.Count, "A").End(3).Row

Şeklinde değiştirip
Dener misiniz

teşekkür hocam elleriniz dert görmesin

 

[numan şamil]

İyi çalışmalar

 

[WelleTy]

İyi çalışmalar

hocam şimdi fark ettim dosyayı katıp actığımda macro çalışmıyor siliniyor kodlar neden

 

[WelleTy]

konu ile ilgili destek olabilecek varmı

 

[Korhan Ayhan]

Dosyanızı "Makro İçeren Çalışma Kitabı" formatında kayıt edip deneyin.

 

[WelleTy]

Dosyanızı "Makro İçeren Çalışma Kitabı" formatında kayıt edip deneyin.

desteğiniz için teşekkür ederim.

Bir sorum daha olaca

Sub sayfalarıaktar()
Dim s1, S2, x As Long
Set s1 = Sheets("GENEL TOPLAM")
Set S2 = Sheets("Sayfa1")
 S2.Range("A3:J" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Satır = 3
 For Each SAYFA In Worksheets
 If SAYFA.Name <> "GENEL TOPLAM" And SAYFA.Name <> "Sayfa1" Then
For x = 3 To SAYFA.Cells(Rows.Count, "I").End(3).Row
If SAYFA.Range("I" & x).Value <> "KALDI" Then
S2.Range("A" & Satır).Value = SAYFA.Range("A" & x).Value
S2.Range("B" & Satır).Value = SAYFA.Range("B" & x).Value
S2.Range("C" & Satır).Value = SAYFA.Range("C" & x).Value
S2.Range("D" & Satır).Value = SAYFA.Range("D" & x).Value
S2.Range("E" & Satır).Value = SAYFA.Range("E" & x).Value
S2.Range("F" & Satır).Value = SAYFA.Range("F" & x).Value
S2.Range("G" & Satır).Value = SAYFA.Range("G" & x).Value
S2.Range("H" & Satır).Value = SAYFA.Range("H" & x).Value
S2.Range("I" & Satır).Value = SAYFA.Range("I" & x).Value
S2.Range("J" & Satır).Value = SAYFA.Range("J" & x).Value
Satır = Satır + 1
End If
Next x
End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation, "Numan Şamil"
End Sub

bu kodda sadece GENEL TOPLAM sayfasını almıyor bunun haricinde başka bir sayfanın da almamasını istiyorum nasıl yapabilirim

 

[WelleTy]

konu hakkında yardım edebilecek varmı

 

[WelleTy]

Macro ile ilgili kod düzenlemesinde yardım edermisiniz

 

[Korhan Ayhan]

Kod içindeki aşağıdaki satırı bulup revize ediniz.

Kırmızı eklemeyi ben yaptım. Siz kendinize göre çoğaltabilirsiniz.

If SAYFA.Name <> "GENEL TOPLAM" And SAYFA.Name <> "Sayfa1"[COLOR="Red"] And SAYFA.Name <> "DENEME"[/COLOR] Then

 

[WelleTy]

Kod içindeki aşağıdaki satırı bulup revize ediniz.

Kırmızı eklemeyi ben yaptım. Siz kendinize göre çoğaltabilirsiniz.

If SAYFA.Name <> "GENEL TOPLAM" And SAYFA.Name <> "Sayfa1"[COLOR="Red"] And SAYFA.Name <> "DENEME"[/COLOR] Then

teşekkür ederim hocam