Skip to main content

AccessTr.neT


Veri Depolama

Veri Depolama

Çözüldü #1
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.
.rar deneme.rar (Dosya Boyutu: 29,32 KB | İndirme Sayısı: 2)
Cevapla
#2
(24/10/2020 18:12)hegu Adlı Kullanıcıdan Alıntı: 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.
.rar deneme_hegu.rar (Dosya Boyutu: 21,43 KB | İndirme Sayısı: 1)
Son Düzenleme: 25/10/2020, 11:04, Düzenleyen: hegu.
Cevapla
#3
(24/10/2020 18:12)hegu Adlı Kullanıcıdan Alıntı: 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.
.rar deneme.rar (Dosya Boyutu: 23,63 KB | İndirme Sayısı: 2)
Cevapla
#4
(24/10/2020 18:12)hegu Adlı Kullanıcıdan Alıntı: 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.
Cevapla
#5
Alttaki gibide olabilir.

Visual Basic Code
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("A2:D" & 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


Visual Basic Code
 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.

Visual Basic Code
syf.Range("A2:D" & syf.Range("A" & Rows.Count).End(3).Row).Copy

Son Düzenleme: 25/10/2020, 15:28, Düzenleyen: feraz.
Cevapla
#6
Yada en iyisi bu.Aktarırken format olarakta aktarır.

Visual Basic Code
Sub SayfaAktar()
    Dim syf As Worksheet
    Application.ScreenUpdating = False
    With ThisWorkbook.Sheets("Depo")
        .Range("A2:D" & Rows.Count).ClearContents
        For Each syf In ThisWorkbook.Sheets
            If LCase(syf.Name) <> "depo" Then
                If WorksheetFunction.CountA(syf.Range("A2:D" & Rows.Count)) > 0 Then
                    syf.Range("A2:D" & 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

Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da