Basit bir site aidat takibi gelir-gider için makro yardım!

Endless033 · 9 Nisan 2021

ekli kitaptaki 1-31 arasındaki tüm sayfadaki verileri mizan aylık özet sayfasına aktarılmasını istiyorum bir tuşa bastıkça devamlı günceli o sayfaya yazdırmasını istiyorum.
not: taployu bozmamak bizim için önemli bozmadan olmazsa en yakın kolay yöntemde kafi..şimdiden tşkler.

YUSUF44 · 9 Nisan 2021

Aşağıdaki makro istediğiniz işlemi yapar ancak bir sonraki mesajımda yapacağım açıklamalara dikkat etmenizi öneririm:

PHP:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")

Application.ScreenUpdating = False
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                Sheets(i).[C7:F19].Copy s1.Cells(yeniB, "B")
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
            End If
            If Sheets(i).[B25] <> "" Then
                yeniG = s1.Cells(Rows.Count, "G").End(3).Row + 1
                Sheets(i).[B25:B30].Copy s1.Cells(yeniG, "G")
                Sheets(i).[E25:F30].Copy s1.Cells(yeniG, "H")
                sonG = s1.Cells(Rows.Count, "G").End(3).Row
                's1.Range("A" & yeni & ":A" & sonB) = Sheets(i).[F5]
            End If
        End If
    Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

YUSUF44 · 9 Nisan 2021

Öncelikle dosyanızın adı NİSAN olduğundan muhtemelen her ay için ayrı dosya kullanıyorsunuz ve her ay da ayrı ayrı gün sayfalarından oluşuyor. Bu tür kullanım sizin de takdir edeceğiniz gibi çok zor olur. Her aya ayrı dosya, her güne ayrı sayfa, muhtemelen her yıla ayrı klasör derken günlük en fazla 13 satır ayırdığınız işlemler için bir çok dosya ve sayfa oluşturacaksınız. Üstelik ilerde aynı gün 13 satırdan daha fazla işlem olduğunda dosya yapısında değişiklikler yapmanız gerekecek (ya da aynı gün için sayfa kopyalama yapacaksınız).

Olması gereken en ideal dosya yapısı tüm verilerin bir dosyada ve bir sayfada bir veritabanı şeklinde düzenli olarak listelenmesidir. O listeye her işlem yaptığınızda o işlemin bilgilerini satır satır kaydetmelisiniz. Daha sonra isterseniz günlük, isterseniz haftalık, aylık ya da yıllık ya da istediğiniz herhangi bir zaman aralığına ait raporlamaları yapabilirsiniz.

Bir de dosyanızda gelirler için tarih sütunu ayırmışsınız ama giderler için ayırmamışsınız.

Endless033 · 9 Nisan 2021

YUSUF44' Alıntı:
Öncelikle dosyanızın adı NİSAN olduğundan muhtemelen her ay için ayrı dosya kullanıyorsunuz ve her ay da ayrı ayrı gün sayfalarından oluşuyor. Bu tür kullanım sizin de takdir edeceğiniz gibi çok zor olur. Her aya ayrı dosya, her güne ayrı sayfa, muhtemelen her yıla ayrı klasör derken günlük en fazla 13 satır ayırdığınız işlemler için bir çok dosya ve sayfa oluşturacaksınız. Üstelik ilerde aynı gün 13 satırdan daha fazla işlem olduğunda dosya yapısında değişiklikler yapmanız gerekecek (ya da aynı gün için sayfa kopyalama yapacaksınız).

Olması gereken en ideal dosya yapısı tüm verilerin bir dosyada ve bir sayfada bir veritabanı şeklinde düzenli olarak listelenmesidir. O listeye her işlem yaptığınızda o işlemin bilgilerini satır satır kaydetmelisiniz. Daha sonra isterseniz günlük, isterseniz haftalık, aylık ya da yıllık ya da istediğiniz herhangi bir zaman aralığına ait raporlamaları yapabilirsiniz.

Bir de dosyanızda gelirler için tarih sütunu ayırmışsınız ama giderler için ayırmamışsınız.

Tarih kısmı her sayfanın üst köşede olduğu için ve gider ve gelir aynı sayfada aynı tarihi teşkil ettiği için gerek duymadım.makro için tşk ederim en kısa zamanda size dönüş yapacağım deneyip ilginiz için tşk ederim dediğimiz gibi 12 ay ayrı ayrı nisan.xlsx gibi her ayın kitabı mevcut sizin aklınızda bir topla ve düzen değişikliğine gidebiliriz yardımcı olursanız makro konusunda zayıfim baya

YUSUF44 · 9 Nisan 2021

Ben günlük sayfalardaki tarihlerden değil ana sayfadaki tarihten bahsediyorum.

Kod her sayfayı ayrı ayrı kontrol ediyor. Önce gelir kısmını kopyalayıp ana sayfada gelir kısmındaki ilk boş satıra yapıştırıyor ve yapıştırdığı satırlar için o günün tarihini tarih sütununa yazıyor.

Sonra o günün giderlerini kopyalayıp ana sayfadaki gider kısmında ilk boş satıra yapıştırıyor. Ancak ana sayfanın gider kısmında ayrıca tarih sütunu olmadığı için gidersin hangi tarihe ait olduğu belli olmuyor.

Bence sitede benzer konuları araştırın, varsa size uygun bir çalışma o çalışmayı size uyarlamaya çalışalım ya da dosya örneği hazırlayın, gerekli yerlerde yardımcı olmaya çalışalım.

Endless033 · 9 Nisan 2021

YUSUF44' Alıntı:
Ben günlük sayfalardaki tarihlerden değil ana sayfadaki tarihten bahsediyorum.

Kod her sayfayı ayrı ayrı kontrol ediyor. Önce gelir kısmını kopyalayıp ana sayfada gelir kısmındaki ilk boş satıra yapıştırıyor ve yapıştırdığı satırlar için o günün tarihini tarih sütununa yazıyor.

Sonra o günün giderlerini kopyalayıp ana sayfadaki gider kısmında ilk boş satıra yapıştırıyor. Ancak ana sayfanın gider kısmında ayrıca tarih sütunu olmadığı için gidersin hangi tarihe ait olduğu belli olmuyor.

Bence sitede benzer konuları araştırın, varsa size uygun bir çalışma o çalışmayı size uyarlamaya çalışalım ya da dosya örneği hazırlayın, gerekli yerlerde yardımcı olmaya çalışalım.

Tamam ben araştırma yapayım.olmadi yenisini düzenler size dönüş yaparım sagolun

spacebar · 9 Nisan 2021

hazırladığım bu dosya belki işinize yarayabilir. koruma şifresi "karzarar" dır.

Endless033 · 10 Nisan 2021

YUSUF44' Alıntı:
Öncelikle dosyanızın adı NİSAN olduğundan muhtemelen her ay için ayrı dosya kullanıyorsunuz ve her ay da ayrı ayrı gün sayfalarından oluşuyor. Bu tür kullanım sizin de takdir edeceğiniz gibi çok zor olur. Her aya ayrı dosya, her güne ayrı sayfa, muhtemelen her yıla ayrı klasör derken günlük en fazla 13 satır ayırdığınız işlemler için bir çok dosya ve sayfa oluşturacaksınız. Üstelik ilerde aynı gün 13 satırdan daha fazla işlem olduğunda dosya yapısında değişiklikler yapmanız gerekecek (ya da aynı gün için sayfa kopyalama yapacaksınız).

Olması gereken en ideal dosya yapısı tüm verilerin bir dosyada ve bir sayfada bir veritabanı şeklinde düzenli olarak listelenmesidir. O listeye her işlem yaptığınızda o işlemin bilgilerini satır satır kaydetmelisiniz. Daha sonra isterseniz günlük, isterseniz haftalık, aylık ya da yıllık ya da istediğiniz herhangi bir zaman aralığına ait raporlamaları yapabilirsiniz.

Bir de dosyanızda gelirler için tarih sütunu ayırmışsınız ama giderler için ayırmamışsınız.

giderler kısmına tarih sutunu ekledim dedğiniz gibi bilgi eksikliği oluyor o şekilde makroyu revize ederseniz sevinirim anca bakabildim işteydim..tam istediğim gibi olmuş bu şekilde işimi görür.bilginiz için tşkler gerçekten
not: komudu çalıştırdığımda her defasında önceki gitirmiş oldugu veriyi silip tekrardan yazdırabilir miyiz.şuan tekrardan çalıştırdığımda altına tekrar aynı veriyi yazıyor

YUSUF44 · 10 Nisan 2021

Aşağıdaki makroyu deneyiniz:

PHP:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")
eski = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "B").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
Application.ScreenUpdating = False
    s1.Range("A6:J" & eski).ClearContents
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                Sheets(i).[C7:F19].Copy s1.Cells(yeniB, "B")
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
            End If
            If Sheets(i).[B25] <> "" Then
                yeniH = s1.Cells(Rows.Count, "H").End(3).Row + 1
                Sheets(i).[B25:B30].Copy s1.Cells(yeniH, "H")
                Sheets(i).[E25:F30].Copy s1.Cells(yeniH, "I")
                sonH = s1.Cells(Rows.Count, "H").End(3).Row
                s1.Range("G" & yeniH & ":G" & sonH) = Sheets(i).[F5]
            End If
        End If
    Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

YUSUF44 · 10 Nisan 2021

Bu arada @spacebar 'ın paylaştığı dosya da çok güzel ve kullanışlı. Tebrik ve teşekkür ederim.

Endless033 · 10 Nisan 2021

YUSUF44' Alıntı:

Aşağıdaki makroyu deneyiniz:

PHP:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")
eski = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "B").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
Application.ScreenUpdating = False
    s1.Range("A6:J" & eski).ClearContents
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                Sheets(i).[C7:F19].Copy s1.Cells(yeniB, "B")
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
            End If
            If Sheets(i).[B25] <> "" Then
                yeniH = s1.Cells(Rows.Count, "H").End(3).Row + 1
                Sheets(i).[B25:B30].Copy s1.Cells(yeniH, "H")
                Sheets(i).[E25:F30].Copy s1.Cells(yeniH, "I")
                sonH = s1.Cells(Rows.Count, "H").End(3).Row
                s1.Range("G" & yeniH & ":G" & sonH) = Sheets(i).[F5]
            End If
        End If
    Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

YUSUF44' Alıntı:
Bu arada @spacebar 'ın paylaştığı dosya da çok güzel ve kullanışlı. Tebrik ve teşekkür ederim.

Aynen sağolsun tşk ettim makro için

Endless033 · 10 Nisan 2021

YUSUF44' Alıntı:

Aşağıdaki makroyu deneyiniz:

PHP:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")
eski = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "B").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
Application.ScreenUpdating = False
    s1.Range("A6:J" & eski).ClearContents
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                Sheets(i).[C7:F19].Copy s1.Cells(yeniB, "B")
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
            End If
            If Sheets(i).[B25] <> "" Then
                yeniH = s1.Cells(Rows.Count, "H").End(3).Row + 1
                Sheets(i).[B25:B30].Copy s1.Cells(yeniH, "H")
                Sheets(i).[E25:F30].Copy s1.Cells(yeniH, "I")
                sonH = s1.Cells(Rows.Count, "H").End(3).Row
                s1.Range("G" & yeniH & ":G" & sonH) = Sheets(i).[F5]
            End If
        End If
    Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

Yusuf bey her komutta çalıştırdığında onceki veriyi siliyor dimi

YUSUF44 · 10 Nisan 2021

Deneyip görün bence. Clearcontents satırı onun için var.

Endless033 · 10 Nisan 2021

YUSUF44' Alıntı:
Deneyip görün bence. Clearcontents satırı onun için var.

Işteyim eve gidince deneyeceğim tşk ederim.bu makroyu bende öğreneceğim bir egitici kaynaktan başlamam lazım

spacebar · 10 Nisan 2021

YUSUF44' Alıntı:
Bu arada @spacebar 'ın paylaştığı dosya da çok güzel ve kullanışlı. Tebrik ve teşekkür ederim.

merhabalar. abim için yapmıştım. makro etkinleştirme bilmediği için sadece formüllerle yaptım. isterseniz kendi ihtiyaçlarınıza göre geliştirebilirsiniz. iyi hafta sonları dilerim.

Endless033 · 11 Nisan 2021

YUSUF44' Alıntı:

Aşağıdaki makroyu deneyiniz:

PHP:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")
eski = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "B").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
Application.ScreenUpdating = False
    s1.Range("A6:J" & eski).ClearContents
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                Sheets(i).[C7:F19].Copy s1.Cells(yeniB, "B")
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
            End If
            If Sheets(i).[B25] <> "" Then
                yeniH = s1.Cells(Rows.Count, "H").End(3).Row + 1
                Sheets(i).[B25:B30].Copy s1.Cells(yeniH, "H")
                Sheets(i).[E25:F30].Copy s1.Cells(yeniH, "I")
                sonH = s1.Cells(Rows.Count, "H").End(3).Row
                s1.Range("G" & yeniH & ":G" & sonH) = Sheets(i).[F5]
            End If
        End If
    Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

yusuf bey aktarınca tablo kenarlık çizgilerle beraber aktarıyor tarih kısmını aktarmayınca iyi olmadı ya tamamen aktarmasın yada düzenli aktarma yapma şanşımız varsa aktarada bilir.

YUSUF44 · 11 Nisan 2021

Aşağıdaki gibi deneyin:

PHP:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")
eski = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "B").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
Application.ScreenUpdating = False
    s1.Range("A6:J" & eski).Clear
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                Sheets(i).[C7:F19].Copy: s1.Cells(yeniB, "B").PasteSpecial Paste:=xlValues
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
                With s1.Range("A" & yeniB & ":E" & sonB)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
            If Sheets(i).[B25] <> "" Then
                yeniH = s1.Cells(Rows.Count, "H").End(3).Row + 1
                Sheets(i).[B25:B30].Copy: s1.Cells(yeniH, "H").PasteSpecial Paste:=xlValues
                Sheets(i).[E25:F30].Copy: s1.Cells(yeniH, "I").PasteSpecial Paste:=xlValues
                sonH = s1.Cells(Rows.Count, "H").End(3).Row
                s1.Range("G" & yeniH & ":G" & sonH) = Sheets(i).[F5]
                With s1.Range("G" & yeniH & ":J" & sonH)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
        End If
    Next
    ensonB = s1.Cells(Rows.Count, "B").End(3).Row
    s1.Range("A6:A" & ensonB).NumberFormat = "dd/mm/yyyy"
    s1.Range("A6:A" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("D6:D" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("E6:E" & ensonB).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("A6:E" & ensonB).VerticalAlignment = xlCenter
    
    ensonG = s1.Cells(Rows.Count, "G").End(3).Row
    s1.Range("G6:G" & ensonG).NumberFormat = "dd/mm/yyyy"
    s1.Range("G6:G" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("I6:I" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("J6:J" & ensonG).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("G6:J" & ensonG).VerticalAlignment = xlCenter
    
    s1.Columns("A:J").EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

Endless033 · 12 Nisan 2021

YUSUF44' Alıntı:

Aşağıdaki gibi deneyin:

PHP:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")
eski = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "B").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
Application.ScreenUpdating = False
    s1.Range("A6:J" & eski).Clear
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                Sheets(i).[C7:F19].Copy: s1.Cells(yeniB, "B").PasteSpecial Paste:=xlValues
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
                With s1.Range("A" & yeniB & ":E" & sonB)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
            If Sheets(i).[B25] <> "" Then
                yeniH = s1.Cells(Rows.Count, "H").End(3).Row + 1
                Sheets(i).[B25:B30].Copy: s1.Cells(yeniH, "H").PasteSpecial Paste:=xlValues
                Sheets(i).[E25:F30].Copy: s1.Cells(yeniH, "I").PasteSpecial Paste:=xlValues
                sonH = s1.Cells(Rows.Count, "H").End(3).Row
                s1.Range("G" & yeniH & ":G" & sonH) = Sheets(i).[F5]
                With s1.Range("G" & yeniH & ":J" & sonH)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
        End If
    Next
    ensonB = s1.Cells(Rows.Count, "B").End(3).Row
    s1.Range("A6:A" & ensonB).NumberFormat = "dd/mm/yyyy"
    s1.Range("A6:A" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("D6:D" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("E6:E" & ensonB).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("A6:E" & ensonB).VerticalAlignment = xlCenter
   
    ensonG = s1.Cells(Rows.Count, "G").End(3).Row
    s1.Range("G6:G" & ensonG).NumberFormat = "dd/mm/yyyy"
    s1.Range("G6:G" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("I6:I" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("J6:J" & ensonG).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("G6:J" & ensonG).VerticalAlignment = xlCenter
   
    s1.Columns("A:J").EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

yusuf bey tşk ederim gayet güzel olmuş tarih arasınıda ayırması daha güzel olmuş emeğinize sağlık

Endless033 · 28 Nisan 2021

YUSUF44' Alıntı:

Aşağıdaki gibi deneyin:

PHP:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")
eski = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "B").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
Application.ScreenUpdating = False
    s1.Range("A6:J" & eski).Clear
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                Sheets(i).[C7:F19].Copy: s1.Cells(yeniB, "B").PasteSpecial Paste:=xlValues
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
                With s1.Range("A" & yeniB & ":E" & sonB)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
            If Sheets(i).[B25] <> "" Then
                yeniH = s1.Cells(Rows.Count, "H").End(3).Row + 1
                Sheets(i).[B25:B30].Copy: s1.Cells(yeniH, "H").PasteSpecial Paste:=xlValues
                Sheets(i).[E25:F30].Copy: s1.Cells(yeniH, "I").PasteSpecial Paste:=xlValues
                sonH = s1.Cells(Rows.Count, "H").End(3).Row
                s1.Range("G" & yeniH & ":G" & sonH) = Sheets(i).[F5]
                With s1.Range("G" & yeniH & ":J" & sonH)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
        End If
    Next
    ensonB = s1.Cells(Rows.Count, "B").End(3).Row
    s1.Range("A6:A" & ensonB).NumberFormat = "dd/mm/yyyy"
    s1.Range("A6:A" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("D6:D" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("E6:E" & ensonB).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("A6:E" & ensonB).VerticalAlignment = xlCenter
   
    ensonG = s1.Cells(Rows.Count, "G").End(3).Row
    s1.Range("G6:G" & ensonG).NumberFormat = "dd/mm/yyyy"
    s1.Range("G6:G" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("I6:I" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("J6:J" & ensonG).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("G6:J" & ensonG).VerticalAlignment = xlCenter
   
    s1.Columns("A:J").EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

Yusuf bey sizi tekrardan rahatsız ediyorum kusura bakmayın taploda gelir ve gider şeklinde belirli bir satır ve sutun aralığı Sheets(i).[C7:F19].Copy: s1.Cells(yeniB, "B").PasteSpecial Paste:=xlValues , Sheets(i).[B25:B30].Copy: s1.Cells(yeniH, "H").PasteSpecial Paste:=xlValues mesala bu alanları son dolu veriye kadar gibi bir kod yazamazmıyız araya satır eklemem gereken durumlar oluyor bu taplo bu şeklide olacağı için bunun dışına çıkmamam gerekli onun için ne kadar satır eklersem ekleyeyim son dolu veriye göre aktarmasını yazabilirmisiniz

YUSUF44 · 29 Nisan 2021

Merhaba, estağfurullah. Deneyiniz:

PHP:

Sub toparla()
Set s1 = Sheets("MİZAN AYLIK ÖZET")
eski = WorksheetFunction.Max(6, s1.Cells(Rows.Count, "B").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
Application.ScreenUpdating = False
    s1.Range("A6:J" & eski).Clear
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> s1.Name Then
            If Sheets(i).[C7] <> "" Then
                yeniB = s1.Cells(Rows.Count, "B").End(3).Row + 1
                songelir = Sheets(i).Cells.Find("GÜNÜN TAHSİLAT TOPLAMI", , , , xlByRows, xlPrevious).Row - 1
                Sheets(i).Range("C7:F" & songelir).Copy: s1.Cells(yeniB, "B").PasteSpecial Paste:=xlValues
                sonB = s1.Cells(Rows.Count, "B").End(3).Row
                s1.Range("A" & yeniB & ":A" & sonB) = Sheets(i).[F5]
                With s1.Range("A" & yeniB & ":E" & sonB)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
            If Sheets(i).[B25] <> "" Then
                yeniH = s1.Cells(Rows.Count, "H").End(3).Row + 1
                ilkgider = Sheets(i).Cells.Find("HARCAMALAR", , , , xlByRows, xlPrevious).Row + 1
                songider = Sheets(i).Cells.Find("TOPLAM HARCAMA", , , , xlByRows, xlPrevious).Row - 1
                Sheets(i).Range("B" & ilkgider & ":B" & songider).Copy s1.Cells(yeniH, "H")
                Sheets(i).Range("E" & ilkgider & ":F" & songider).Copy s1.Cells(yeniH, "I")
                sonH = s1.Cells(Rows.Count, "H").End(3).Row
                s1.Range("G" & yeniH & ":G" & sonH) = Sheets(i).[F5]
                With s1.Range("G" & yeniH & ":J" & sonH)
                    .Borders.LineStyle = 9
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End If
        End If
    Next
    ensonB = s1.Cells(Rows.Count, "B").End(3).Row
    s1.Range("A6:A" & ensonB).NumberFormat = "dd/mm/yyyy"
    s1.Range("A6:A" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("D6:D" & ensonB).HorizontalAlignment = xlCenter
    s1.Range("E6:E" & ensonB).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("A6:E" & ensonB).VerticalAlignment = xlCenter
    s1.Range("A6:E" & ensonB).Font.Bold = False
    
    ensonG = s1.Cells(Rows.Count, "G").End(3).Row
    s1.Range("G6:G" & ensonG).NumberFormat = "dd/mm/yyyy"
    s1.Range("G6:G" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("I6:I" & ensonG).HorizontalAlignment = xlCenter
    s1.Range("J6:J" & ensonG).NumberFormat = "$#,##0.00_);($#,##0.00)"
    s1.Range("G6:J" & ensonG).VerticalAlignment = xlCenter
    s1.Range("G6:J" & ensonG).Font.Bold = False
    s1.Range("J6:J" & ensonG).HorizontalAlignment = xlRight
    
    s1.Columns("A:J").EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı.", vbInformation
End Sub

Basit bir site aidat takibi gelir-gider için makro yardım!

Endless033

Ekli dosyalar

YUSUF44

Destek Ekibi

YUSUF44

Destek Ekibi

Endless033

YUSUF44

Destek Ekibi

Endless033

spacebar

Ekli dosyalar

Endless033

Ekli dosyalar

YUSUF44

Destek Ekibi

YUSUF44

Destek Ekibi

Endless033

Endless033

YUSUF44

Destek Ekibi

Endless033

spacebar

Endless033

YUSUF44

Destek Ekibi

Endless033

Endless033

YUSUF44

Destek Ekibi