• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Farklı Sayfalardaki Verileri Tek Sayfada birleştirmek Hak.

  • Konbuyu başlatan Konbuyu başlatan erseljti
  • Başlangıç tarihi Başlangıç tarihi
Katılım
20 Ocak 2012
Mesajlar
118
Excel Vers. ve Dili
Office 2016-Türkçe
Üstadlar Merhaba Farklı Sheetlerdeki verileri tek bir Sheetde toparlamak istiyorum.
Yani Her bayinin bir kodu var bu kodu esas alarak diğer Sheetledeki kodları arasın bulsun ve Konsolide Sheetinde birleştirsin.Detaylı anlatım EKteki dosyada Mevcut Yardımlarınızı rica ederim.
Ayrıca bunu Makro olarakta yapmak mümkün mü???
 

Ekli dosyalar

. . .

Kod:
Sub Kod()
Application.ScreenUpdating = False
On Error Resume Next
Dim U As Long
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim S4 As Worksheet, S5 As Worksheet, S6 As Worksheet
Dim S7 As Worksheet, S8 As Worksheet, S9 As Worksheet
Dim S10 As Worksheet, S11 As Worksheet, S12 As Worksheet
Dim SK As Worksheet

Set SK = Sheets("Konsolide")
Set S1 = Sheets("ocak")
Set S2 = Sheets("şubat")
Set S3 = Sheets("mart")
Set S4 = Sheets("nisan")
Set S5 = Sheets("mayıs")
Set S6 = Sheets("haziran")
Set S7 = Sheets("temmuz")
Set S8 = Sheets("ağustos")
Set S9 = Sheets("eylül")
Set S10 = Sheets("ekim")
Set S11 = Sheets("kasım")
Set S12 = Sheets("aralık")

SK.Range("B2:N65536").ClearContents
    
For U = 2 To SK.[A65536].End(3).Row

If SK.Cells(U, "A") <> "" Then

SK.Cells(U, "B") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S1.Range("a:b"), 2, 0)
SK.Cells(U, "c") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S1.Range("a:c"), 3, 0)
SK.Cells(U, "d") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S2.Range("a:c"), 3, 0)
SK.Cells(U, "e") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S3.Range("a:c"), 3, 0)
SK.Cells(U, "f") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S4.Range("a:c"), 3, 0)
SK.Cells(U, "g") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S5.Range("a:c"), 3, 0)
SK.Cells(U, "h") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S6.Range("a:c"), 3, 0)
SK.Cells(U, "ı") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S7.Range("a:c"), 3, 0)
SK.Cells(U, "j") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S8.Range("a:c"), 3, 0)
SK.Cells(U, "k") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S9.Range("a:c"), 3, 0)
SK.Cells(U, "l") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S10.Range("a:c"), 3, 0)
SK.Cells(U, "m") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S11.Range("a:c"), 3, 0)
SK.Cells(U, "n") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S12.Range("a:c"), 3, 0)
Else
SK.Cells(U, "B") = ""
SK.Cells(U, "C") = ""
SK.Cells(U, "D") = ""
SK.Cells(U, "E") = ""
SK.Cells(U, "F") = ""
SK.Cells(U, "G") = ""
SK.Cells(U, "H") = ""
SK.Cells(U, "I") = ""
SK.Cells(U, "J") = ""
SK.Cells(U, "K") = ""
SK.Cells(U, "L") = ""
SK.Cells(U, "M") = ""
SK.Cells(U, "N") = ""
End If

Next U

Application.ScreenUpdating = True
MsgBox " B İ T T İ "
End Sub

. . .
 
Son düzenleme:
Katkılarınız için teşekkürler.
 
. . .

Kod:
Sub Kod()
Application.ScreenUpdating = False
On Error Resume Next
Dim U As Long
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim S4 As Worksheet, S5 As Worksheet, S6 As Worksheet
Dim S7 As Worksheet, S8 As Worksheet, S9 As Worksheet
Dim S10 As Worksheet, S11 As Worksheet, S12 As Worksheet
Dim SK As Worksheet

Set SK = Sheets("Konsolide")
Set S1 = Sheets("ocak")
Set S2 = Sheets("şubat")
Set S3 = Sheets("mart")
Set S4 = Sheets("nisan")
Set S5 = Sheets("mayıs")
Set S6 = Sheets("haziran")
Set S7 = Sheets("temmuz")
Set S8 = Sheets("ağustos")
Set S9 = Sheets("eylül")
Set S10 = Sheets("ekim")
Set S11 = Sheets("kasım")
Set S12 = Sheets("aralık")

SK.Range("B2:N65536").ClearContents
    
For U = 2 To SK.[A65536].End(3).Row

If SK.Cells(U, "A") <> "" Then

SK.Cells(U, "B") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S1.Range("a:b"), 2, 0)
SK.Cells(U, "c") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S1.Range("a:c"), 3, 0)
SK.Cells(U, "d") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S2.Range("a:c"), 3, 0)
SK.Cells(U, "e") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S3.Range("a:c"), 3, 0)
SK.Cells(U, "f") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S4.Range("a:c"), 3, 0)
SK.Cells(U, "g") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S5.Range("a:c"), 3, 0)
SK.Cells(U, "h") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S6.Range("a:c"), 3, 0)
SK.Cells(U, "ı") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S7.Range("a:c"), 3, 0)
SK.Cells(U, "j") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S8.Range("a:c"), 3, 0)
SK.Cells(U, "k") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S9.Range("a:c"), 3, 0)
SK.Cells(U, "l") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S10.Range("a:c"), 3, 0)
SK.Cells(U, "m") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S11.Range("a:c"), 3, 0)
SK.Cells(U, "n") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S12.Range("a:c"), 3, 0)
Else
SK.Cells(U, "B") = ""
SK.Cells(U, "C") = ""
SK.Cells(U, "D") = ""
SK.Cells(U, "E") = ""
SK.Cells(U, "F") = ""
SK.Cells(U, "G") = ""
SK.Cells(U, "H") = ""
SK.Cells(U, "I") = ""
SK.Cells(U, "J") = ""
SK.Cells(U, "K") = ""
SK.Cells(U, "L") = ""
SK.Cells(U, "M") = ""
SK.Cells(U, "N") = ""
End If

Next U

Application.ScreenUpdating = True
MsgBox " B İ T T İ "
End Sub

. . .

Hocam desteğiniz için teşekkürler.
Yanlız Ocak Sheetinde olmayan Bayi isimlerini yazmıyor Çalışmayı EKteki dosyaya göre revize etme şansımız varmı????
Burda istediğim Konsolide Sheetinde Yer Alan Bayi ve Bilgileri kalıp Ocak ,Şubat,Mart,Nisan,Mayıs,HAziran,Temmuz ....şeklinde aynı bayi kodlarının verilerini alması
 

Ekli dosyalar

. . .

Kod:
Sub Kod()
Application.ScreenUpdating = False
On Error Resume Next
Dim U As Long
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim S4 As Worksheet, S5 As Worksheet, S6 As Worksheet
Dim S7 As Worksheet, S8 As Worksheet, S9 As Worksheet
Dim S10 As Worksheet, S11 As Worksheet, S12 As Worksheet
Dim SK As Worksheet

Set SK = Sheets("Konsolide")
Set S1 = Sheets("ocak")
Set S2 = Sheets("şubat")
Set S3 = Sheets("mart")
Set S4 = Sheets("nisan")
Set S5 = Sheets("mayıs")
Set S6 = Sheets("haziran")
Set S7 = Sheets("temmuz")
Set S8 = Sheets("ağustos")
Set S9 = Sheets("eylül")
Set S10 = Sheets("ekim")
Set S11 = Sheets("kasım")
Set S12 = Sheets("aralık")

SK.Range("F2:Q65536").ClearContents
    
For U = 2 To SK.[A65536].End(3).Row

If SK.Cells(U, "A") <> "" Then

SK.Cells(U, "F") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S1.Range("a:c"), 2, 0)
SK.Cells(U, "G") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S2.Range("a:c"), 2, 0)
SK.Cells(U, "H") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S3.Range("a:c"), 2, 0)
SK.Cells(U, "I") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S4.Range("a:c"), 2, 0)
SK.Cells(U, "J") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S5.Range("a:c"), 2, 0)
SK.Cells(U, "K") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S6.Range("a:c"), 2, 0)
SK.Cells(U, "L") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S7.Range("a:c"), 2, 0)
SK.Cells(U, "M") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S8.Range("a:c"), 2, 0)
SK.Cells(U, "N") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S9.Range("a:c"), 2, 0)
SK.Cells(U, "O") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S10.Range("a:c"), 2, 0)
SK.Cells(U, "P") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S11.Range("a:c"), 2, 0)
SK.Cells(U, "Q") = WorksheetFunction.VLookup(SK.Cells(U, "A"), S12.Range("a:c"), 2, 0)
Else
SK.Cells(U, "F") = ""
SK.Cells(U, "G") = ""
SK.Cells(U, "H") = ""
SK.Cells(U, "I") = ""
SK.Cells(U, "J") = ""
SK.Cells(U, "K") = ""
SK.Cells(U, "L") = ""
SK.Cells(U, "M") = ""
SK.Cells(U, "N") = ""
SK.Cells(U, "O") = ""
SK.Cells(U, "P") = ""
SK.Cells(U, "Q") = ""
End If

Next U

Application.ScreenUpdating = True
MsgBox " B İ T T İ "
End Sub

. . .
 
Hocam desteğiniz için çok teşekkür derim.Emeğinize Sağlık
 
değişik sayfaların satırlarındaki bilgiyi tek sayfada birleştirmek

huseyın bey merhaba,
Burada verdiğiniz makroyu exelde hazırlanan apartman işletme defterinin gelirler hanesine tarih, daire no, açıklama (hangi malik ödediyse) ve ödeme miktarı şeklinde yazdırma mümkün mü?
Yani, ocak, şubat, mart, nisan, mayıs, haziran, temmuz, ağustos, eylül, ekim, kasım, aralık, sayafa4 vs. sayfalarının satırlarına daire no, açıklama (hangi malik ödediyse) ve ödeme miktarı sırasıyla yazılanbilgileri tek bir sayfada aynı şekilde birleştireceğiz. ekteki örnekteki HesapÖzeti ve AylıkAidatMiktarı sayfaları haricindeki sayfadaki bilgileri İşletmeDefteri sayfasına yazdırmak mümkün mü?
Teşekkür ederim.
 

Ekli dosyalar

Son düzenleme:
huseyın bey merhaba,
Burada verdiğiniz makroyu exelde hazırlanan apartman işletme defterinin gelirler hanesine tarih, daire no, açıklama (hangi malik ödediyse) ve ödeme miktarı şeklinde yazdırma mümkün mü?
Yani, ocak, şubat, mart, nisan, mayıs, haziran, temmuz, ağustos, eylül, ekim, kasım, aralık, sayafa4 vs. sayfalarının satırlarına daire no, açıklama (hangi malik ödediyse) ve ödeme miktarı sırasıyla yazılanbilgileri tek bir sayfada aynı şekilde birleştireceğiz. ekteki örnekteki HesapÖzeti ve AylıkAidatMiktarı sayfaları haricindeki sayfadaki bilgileri İşletmeDefteri sayfasına yazdırmak mümkün mü?
Teşekkür ederim.

. . .

Yapılabilir.

Sadece aylar sayfasındaki veriler mi aktarılacak ?
Kasım ve Aralık sayfasında tutar kısımları boş olanlar var.
Onlarda aktarılacak mı?

. . .
 
değişik sayfaların satırlarındaki bilgiyi tek sayfada birleştirmek

huseyın bey merhaba,
aylar sayfası ve akabindeki kapıcı elkt sayfasındaki bilgi işletme defterinin ilgili yerlerine yazdırılacak. bazı apartman sakinleri ödeme yapmadığı için dolayısıylşa borçlu görünüyorlar, o sütunlar da boş görünüyor. ödeme yaptıklarında, yaptıkları tarih itibarıyle ilgili aya işliyorum.örneği eklemiştim ama vaktiniz olmadı sanırım.
kısaca:
Ocak; Şubat; Mart; Nisan; Mayıs; Haziran; Temmuz; Ağustos; Eylül; Ekim; Kasım; Aralık; KapıcıElkt sayfalarındaki satır 5 den satır 65636 ye kadar olan E, F, G, I sütunlarındaki bilgileri buradaki işletme defterinin gelirler hanesindeki H=Tarih; I=DaireNo,J=Açıklama, K=Ödeme sütunlarına yazdırılacak.

hoşçakalın.
 

Ekli dosyalar

. . .

Sorduğum sorunun cevabı yok ama,
aşağıdaki kodları deneyiniz.

Kod:
Sub Kod()
Application.ScreenUpdating = False
On Error Resume Next
Dim i As Long
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim S4 As Worksheet, S5 As Worksheet, S6 As Worksheet
Dim S7 As Worksheet, S8 As Worksheet, S9 As Worksheet
Dim S10 As Worksheet, S11 As Worksheet, S12 As Worksheet
Dim Sid As Worksheet, SE As Worksheet

Set Sid = Sheets("İşletmeDefteri")
Set S1 = Sheets("OCAK")
Set S2 = Sheets("ŞUBAT")
Set S3 = Sheets("MART")
Set S4 = Sheets("NİSAN")
Set S5 = Sheets("MAYIS")
Set S6 = Sheets("HAZİRAN")
Set S7 = Sheets("TEMMUZ")
Set S8 = Sheets("AĞUSTOS")
Set S9 = Sheets("EYLÜL")
Set S10 = Sheets("EKİM")
Set S11 = Sheets("KASIM")
Set S12 = Sheets("ARALIK")
Set SE = Sheets("KapıcıElkt")

Sid.Range("G8:K65536").ClearContents
satır = 8

S1.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır

If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

S2.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

S3.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

S4.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

S5.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

S6.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

S7.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

S8.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

S9.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

S10.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

S11.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

S12.Select
sayfa_satır = [E65536].End(3).Row
For i = 5 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty

SE.Select
sayfa_satır = [E65536].End(3).Row
For i = 3 To sayfa_satır
If Cells(i, "I") > 0 Then
Sid.Cells(satır, "G") = satır - 7
Sid.Cells(satır, "H") = Cells(i, "G")
Sid.Cells(satır, "I") = Cells(i, "E")
Sid.Cells(satır, "J") = Cells(i, "F")
Sid.Cells(satır, "K") = Cells(i, "I")
satır = satır + 1
Else: End If
Next i
i = Empty
sayfa_satır = Empty


Sid.Select
satır = Empty

Application.ScreenUpdating = True
MsgBox " B İ T T İ "
End Sub

. . .
 
Sayın Hüseyin Çoban,

Bu kodlardan ben de yararlandım. Size ve emeği geçen herkese teşekkürler.

Bu arada, Kurban bayramınızı önceden kutlar. Sevdiklerinizle birlikte nica güzel bayramlar dilerim.

Sevgi ve saygılar.
 
huseyın bey merhaba,
size o sayfadaki "ÖDEME"sütununun boş olma sebebini yazdığımı sanıyorum. ödeme yapanları işletme defterine ödeme tarihine göre yazıyoruz. ödeme yapmayanın yeri dolayısıyla boş kalıyor. tahakkukları da aylar sayfalarının "AİDAT" sütununda gösteriyoruz.
kusura bakmayın bayram arfesinde zamanınızı ayırıp makroyu yazmışınız. şu an denedim istediğim şekilde olmuş. ödeme yapanlar aktarılıyor. yapabilirsem sizden kopya çekerek giderler kısmını da ben yapmaya çalışacağım. yine her aya bir sayfa ayırarak.
yazmakla da olsa sizle tanıştığımıza memnun oldum. sizin ve ailenizin kurban bayramı kutlu olsun. iyi çalışmalar. huseyın bey.
 
Geri
Üst