Sütündaki Verileri 50 Şer olarak satıra aktarma

[Ahmet54]

Merhaba Arkadaşlar;
Bu konu başlığını seçerken epey zorlandım. Nasıl ifade edeceğimi bilemedim mazur görün.

Sorunun şu;
Ekteki dosyadan da anlaşılacağı üzere Excell dosyasının 2. sayfası olan STOK GİRİŞ sayfası devamlı değişikliğe uğruyor. Bu değişiklik farklı bir excel dosyasında olmakta. Diğer excell dosyasından bu sayfaya kopyalayarak elde edilmekte.

Stok giriş sayfasındaki A-B-C-D-E-F sütunundaki verileri "STOK MAİL" sayfasınraki ikiye bölünmüş sayfanın sol tarafından başlayarak kopyalamasını sayfa sonuna geldiğinde; bölünmüş olan sayfanın G-H-I-J-K-L sütunlarında kopyalamasını ve yine sayfa sonuna geldiğinde 2. sayfaya geçerek 2. sayfanın başladığı satırdan devam etmesini istiyorum. Böylece bu sayfayı PDF ye çevirdiğimde tek a4 boyutunda sıralı iki bölüm oluşturmuş olacağım.(Sayfada filigran tarzı üst bilgi olarak şiket antedini yerleştireceğim için yazdırma alanı değişmemeli.)


Biraz uzun oldu ama umarım anlatabilmişimdir. Yardımcı olabilecek arkadaşlara şimdiden teşekkürler.

 

[Ömer]

Merhaba,

Önce "sablon" adında bir sayfa oluşturup sayfa düzenini bu sayfaya göre düzenleyin.

Daha sonra aşağıdaki kodları çalıştırın. Açılan sayfalar "sablon" sayfasına göre açılır. Bu şekilde tek sayfa üzerinden istediğiniz değişikliği baştan yapabilirsiniz.

Detaylı deneme yapmadım.

Sub Sayafalara_Dagit()
 
    Dim i As Long, olcut_sat As Long, olcut_sut As Integer, sut_say As Integer
    Dim son_sat As Long, a1 As Integer, a2 As Integer, a3 As Integer, Sm As Worksheet

    Application.ScreenUpdating = False
    
   ' Sayfa_Sil 'işleme başlamadan değişken ve sablon sayfalası dışındakileri siler
    
    olcut_sat = 50 ' aktarılacak satır sayısı
    olcut_sut = 2 ' aktarılacak sütun sayısı
    sut_say = 6 'tablodaki sütun sayısı
    
    With Sheets("Stok Giriş (DEĞİŞKEN)")
        son_sat = .Cells(Rows.Count, "A").End(xlUp).Row
        a1 = 1: a2 = 1
        For i = 2 To son_sat Step olcut_sat
            If a2 = 1 Or a2 > olcut_sut Then
                a3 = 1[COLOR="Red"]: a2 = 1[/COLOR]
                Sheets("sablon").Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = "Mail_Listesi" & a1
                a1 = a1 + 1
                Set Sm = Sheets(ActiveSheet.Name)
            End If
            .Cells(i, "A").Resize(olcut_sat, sut_say).Copy Sm.Cells(2, a3)
            a3 = a3 + sut_say
            a2 = a2 + 1
        Next i
    End With
    
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamam", , "excel.web.tr"
    
End Sub

Sub Sayfa_Sil()
 
    Dim j As Integer
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    'Stok Giriş (DEĞİŞKEN) ve sablon sayfası dışındaki sayfaları siler
    For j = Worksheets.Count To 1 Step -1
        With Sheets(j)
            If .Name <> "Stok Giriş (DEĞİŞKEN)" And _
                .Name <> "sablon" Then
                .Delete
            End If
        End With
    Next j
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

.

 

[Ahmet54]

Merhaba;
Kusura bakmayın bazı nedenlerden dolayı giriş yapamadım. Verdiğiniz kodları uygulayıp bilgi vereceğim. İlginiz için teşekkür ederim.

 

[Ahmet54]

Merhaba;
Vermiş olduğunuz kodu excel dosyasında uyguladım. Bir tane "sablon" sayfası oluşturdum. Ancak sadece 100 satırı ilk sayfaya alıyor 50 satır sol tarafa 50 satır sağ tarafa kopyalıyor. İkinci sayfaya ise stok değişken sayfasındaki verileri alıyor.


Not: Veriler yaklaşık 1500 satır civarındadır.

 

[Ömer]

Bu hazırladığınız örneği ekler misiniz.

.

 

[Ahmet54]

Dosya Ektedir Ömer Bey. Sanırım ben beceremedim.

 

[Ömer]

#2 numaralı mesajı değiştirim. İlave kırmızı işaretli bölüm.

Detaylı deneme yapmadım.

.

 

[Ahmet54]

İlginiz için çok teşekkür ederim Ömer Bey.
Ancak her A4 boyutu için ayrı bir sayfa oluşturmakta. Bunun yerine alt alta yapma imkanımız var mı? Böylelikle PDF uzantısı olarak kayıt ettiğimde bir dosyada görme imakanım olacaktır.

 

[Ömer]

Ben ayrı sayfa olarak algılamıştım.

Bu şekilde deneyin.

Detaylı deneme yapmadım.

Sub Aktar()
 
    Dim i As Long, olcut_sat As Long, olcut_sut As Integer, sut_say As Integer
    Dim son_sat As Long, a1 As Integer, a2 As Integer, a3 As Long

    olcut_sat = 50 ' aktarılacak satır sayısı
    olcut_sut = 2 ' aktarılacak sütun sayısı
    sut_say = 6 'tablodaki sütun sayısı
    
    Application.ScreenUpdating = False
    Sheets("sablon").Select
    Range("A2:N" & Rows.Count).ClearContents
    
    a1 = 1: a2 = 1: a3 = 2
    With Sheets("Stok Giriş (DEĞİŞKEN)")
        son_sat = .Cells(Rows.Count, "A").End(xlUp).Row
        For i = 2 To son_sat Step olcut_sat
            If a2 > olcut_sut Then a1 = 1: a2 = 1: a3 = Cells(Rows.Count, "A").End(xlUp).Row + 1
            .Cells(i, "A").Resize(olcut_sat, sut_say).Copy Cells(a3, a1)
            a1 = a1 + sut_say
            a2 = a2 + 1
           Next i
    End With
    
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamam", , "excel.web.tr"
    
End Sub

.

 

[Ahmet54]

Teşekkür ederim Ömer Bey.
Çok makbule geçti. Çalışmalarınızda başarılar dilerim.

 

[ex48]

Ben ayrı sayfa olarak algılamıştım.

Bu şekilde deneyin.

Detaylı deneme yapmadım.

Sub Aktar()
 
    Dim i As Long, olcut_sat As Long, olcut_sut As Integer, sut_say As Integer
    Dim son_sat As Long, a1 As Integer, a2 As Integer, a3 As Long

    olcut_sat = 50 ' aktarılacak satır sayısı
    olcut_sut = 2 ' aktarılacak sütun sayısı
    sut_say = 6 'tablodaki sütun sayısı
    
    Application.ScreenUpdating = False
    Sheets("sablon").Select
    Range("A2:N" & Rows.Count).ClearContents
    
    a1 = 1: a2 = 1: a3 = 2
    With Sheets("Stok Giriş (DEĞİŞKEN)")
        son_sat = .Cells(Rows.Count, "A").End(xlUp).Row
        For i = 2 To son_sat Step olcut_sat
            If a2 > olcut_sut Then a1 = 1: a2 = 1: a3 = Cells(Rows.Count, "A").End(xlUp).Row + 1
            .Cells(i, "A").Resize(olcut_sat, sut_say).Copy Cells(a3, a1)
            a1 = a1 + sut_say
            a2 = a2 + 1
           Next i
    End With
    
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamam", , "excel.web.tr"
    
End Sub

.

Merhaba,
Yukarıdaki kodları
a4sayfaya düşen satır sayısı: 69
Solda A4:F sağda H4:M aralığında veriler olacak şekilde aşağıdaki değişiklikleri yaparak kendi dosyama uyarladım, oluşan sayfalarda bir sıkıntı yok gibi.
kodlarda değiştirmeyi atladığım başka bir alan veya hataya neden olacak değişiklik var mı bakabilirseniz.

Değiştirdiğim kodlar:
önceki------------------------------------------------------değişiklik
olcut_sat = 50 ' aktarılacak satır sayısı------------------69
Sheets("sablon").Select-----------------------------------LİSTE_son
Range("A2:N" & Rows.Count).ClearContents------------A4:M
a1 = 1: a2 = 1: a3 = 2-----------------------------------a3 = 4
With Sheets("Stok Giriş (DEĞİŞKEN)")----------------- LİSTE
son_sat = .Cells(Rows.Count, "A").End(xlUp).Row------Row + 1
For i = 2 To son_sat Step olcut_sat----------------------4
a1 = a1 + sut_say----------------------------------------sut_say + 1

ayrıca dosyayı ekledim.

Teşekkür ederim.