AccessTr.neT
Veri Depolama - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Veri Depolama (/konu-veri-depolama.html)

Sayfalar: 1 2

Veri Depolama - hegu - 24/10/2020

Ekte örneğini koyduğum çalışmada hangi aya veri girilirse aynı zamanda otomatik depoda toplanmasını istiyorum. Ben dört sütun veri yazdım bu fazla sütun da olabilir. Yardımlarınız için teşekkür ederim.

RE: Veri Depolama - hegu - 25/10/2020

(24/10/2020, 18:12)hegu yazdı: Ekte örneğini koyduğum çalışmada hangi aya veri girilirse aynı zamanda otomatik depoda toplanmasını istiyorum. Ben dört sütun veri yazdım bu fazla sütun da olabilir. Yardımlarınız için teşekkür ederim.

kopyalama makrosu ile hallettim. Bilgi amaçlı örneği yüklüyorum. Farklı bir yol varsa da onu da görmek isterim. teşekkür ederim.

RE: Veri Depolama - hegu - 25/10/2020

(24/10/2020, 18:12)hegu yazdı: Ekte örneğini koyduğum çalışmada hangi aya veri girilirse aynı zamanda otomatik depoda toplanmasını istiyorum. Ben dört sütun veri yazdım bu fazla sütun da olabilir. Yardımlarınız için teşekkür ederim.
Aktar tuşuyla aktar örneği de ektedir.

RE: Veri Depolama - feraz - 25/10/2020

(24/10/2020, 18:12)hegu yazdı: hangi aya veri girilirse aynı zamanda otomatik depoda toplanmasını istiyorum
Merhaba.
Yukarıdaki yazdığınıza göre sayfada değişiklik olunca aktarması gerekiyor lakin sizin kod Depo sayfasını silip Ay sayfalarındaki verileri kopyalayıp aktarıyor.
istediğiniz veri girincemi yoksa nasıl olacak.

RE: Veri Depolama - feraz - 25/10/2020

Alttaki gibide olabilir.

Sub SayfaAktar()

    Dim syf As Worksheet

    Application.ScreenUpdating = False

    With ThisWorkbook.Sheets("Depo")

        .Range("A2:L" & Rows.Count).ClearContents

        For Each syf In ThisWorkbook.Sheets

            If LCase(syf.Name) <> "depo" Then

                If WorksheetFunction.CountA(syf.Range("A2Lol" & Rows.Count)) > 0 Then

                    syf.Range(syf.Range("A2"), syf.Range("A1").End(xlDown).End(xlToRight)).Copy

                    .Range("A" & Rows.Count).End(3)(2, 1).PasteSpecial xlValues

                End If

            End If

        Next

    End With

    MsgBox "islem tamam...", vbInformation, "Bilgi"

    Application.ScreenUpdating = True

    Application.CutCopyMode = False

End Sub


 syf.Range(syf.Range("A2"), syf.Range("A1").End(xlDown).End(xlToRight)).Copy
Eğer satırlar arasında boş olacaksa örneğin Tc sütunucaki satırda boş veri olursa alttaki gibi değiştirilir yukarıdaki kodun.

syf.Range("A2Lol" & syf.Range("A" & Rows.Count).End(3).Row).Copy


RE: Veri Depolama - feraz - 25/10/2020

Yada en iyisi bu.Aktarırken format olarakta aktarır.

Sub SayfaAktar()

    Dim syf As Worksheet

    Application.ScreenUpdating = False

    With ThisWorkbook.Sheets("Depo")

        .Range("A2Lol" & Rows.Count).ClearContents

        For Each syf In ThisWorkbook.Sheets

            If LCase(syf.Name) <> "depo" Then

                If WorksheetFunction.CountA(syf.Range("A2Lol" & Rows.Count)) > 0 Then

                    syf.Range("A2Lol" & syf.Range("A" & Rows.Count).End(3).Row).Copy

                    .Range("A" & Rows.Count).End(3)(2, 1).PasteSpecial xlPasteValuesAndNumberFormats

                End If

            End If

        Next

    End With

    MsgBox "islem tamam...", vbInformation, "Bilgi"

    Application.ScreenUpdating = True

    Application.CutCopyMode = False

End Sub