sayfalar arası veri aktarımında sayfa sınırlama

[numan şamil]

Merhaba arkadaşlar
Aşağıda Evren beyin kodlarında bir dosya içerisindeki sayfalardaki A1 hücre değerlerini çalışma sayfasına alt alta ekliyor ve sayfa eklendikçe otomatik olarak eklenen sayfanın a1 hücrelerinide alıyor çok güzel çalışma
benim istediğim dosyadaki veri aktarılacak sayfalarda sınırlama yapılabilirmi? örneğin sadece ilk ve son sayfalar arasında veri aktarımı yapılması diğer sayfalardaki verileri aktarmayacak (ilk ve son sayfa adlı sayfaların sayısı 70'den fazla ve sürekli artıyor)
Sub a1_hucrelerini_ekle()
Dim i As Long, sat As Long
Sheets("DATA").Select
Application.ScreenUpdating = False
Range("A:A").ClearContents
For i = 2 To Worksheets.Count
sat = sat + 1
Cells(sat, "A").Value = Sheets(i).Range("A1").Value
Next i
Cells(sat, "A").Select
Application.ScreenUpdating = True
MsgBox "A1 Hücreleri aktarıldı..", vbOKOnly + vbInformation, "Evren GİZLEN"
End Sub

 

[numan şamil]

Arkadaşlar bir fikri olan varmı?

 

[numan şamil]

Merhaba arkadaşlar
Aşağıda Evren beyin kodlarında bir dosya içerisindeki sayfalardaki A1 hücre değerlerini çalışma sayfasına alt alta ekliyor ve sayfa eklendikçe otomatik olarak eklenen sayfanın a1 hücrelerinide alıyor çok güzel çalışma
benim istediğim dosyadaki veri aktarılacak sayfalarda sınırlama yapılabilirmi? örneğin sadece ilk ve son sayfalar arasında veri aktarımı yapılması diğer sayfalardaki verileri aktarmayacak (ilk ve son sayfa adlı sayfaların sayısı 70'den fazla ve sürekli artıyor)
Sub a1_hucrelerini_ekle()
Dim i As Long, sat As Long
Sheets("DATA").Select
Application.ScreenUpdating = False
Range("A:A").ClearContents
For i = 2 To Worksheets.Count
sat = sat + 1
Cells(sat, "A").Value = Sheets(i).Range("A1").Value
Next i
Cells(sat, "A").Select
Application.ScreenUpdating = True
MsgBox "A1 Hücreleri aktarıldı..", vbOKOnly + vbInformation, "Evren GİZLEN"
End Sub
Uzman arkadaşlar Yukarıdaki Evren beyin kodlarını ekli dosyaya nasıl uyguluya bilirim . yardım edebilirmisiniz?

 

[numan şamil]

Uzman arkadaşlar istediğim olmayacak bir şeymi ? bu konuda beni aydınlatırmısınız? veri aktarımında belirlenen iki sayfa arasındaki sayfalardan veri aktarıla bilinirmi? böyle bir seçim nasıl olur? aktarılacak olan sayfalar sürekli artıyor kodlarda bu yüzden sayfa ismi yazamıyorum?

 

[numan şamil]

volkangandalf tarafından gönderildi
"Başarmak ise hazın
Bir şeyler yapmak lazım

Bilmiyorsan ilmini
Bilene danışmak lazım

Çözmen için derdini
Muhatap alınman lazım

İyi de arkadaşlar
Benim ne yapmam lazım"
(yukarıdaki dizeler volkangandalf tarafından alıntıdır)


Şaire katılmamak elde değil
şiir yazmak her kesin karı değil
Uzmanlar sizi yoruyoruz elde değil
Sorumun akıbeti ne olacak belli değil?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. Siz P sütununu birleştirilmiş hücre gibi aktarmışsınız. Ben gerek duymadığım için düz aktardım. Birleşmiş hücre olarak istiyorsanız kodu revize etmek gerekecektir.

Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, SAYFA As Worksheet, Satır As Long
 
    Set S1 = Sheets("Raporlama")
 
    If S1.Range("A2") = "" Then
        Satır = 2
    Else
        Satır = S1.Cells(Rows.Count, 1).End(3).Row + 1
    End If
 
    Application.ScreenUpdating = False
 
    For Each SAYFA In ThisWorkbook.Worksheets
        If SAYFA.Index > Sheets("ilk sayfa").Index And SAYFA.Index < Sheets("son sayfa").Index Then
            S1.Cells(Satır, 1) = SAYFA.Range("H2")
            S1.Cells(Satır, 2) = SAYFA.Range("B2")
            S1.Cells(Satır, 3) = SAYFA.Range("H1")
            S1.Cells(Satır, 4) = SAYFA.Range("H3")
            S1.Cells(Satır, 5) = SAYFA.Range("K2")
            S1.Cells(Satır, 6) = SAYFA.Range("C3")
            S1.Cells(Satır, 7) = SAYFA.Range("F3")
            S1.Cells(Satır, 8) = SAYFA.Range("C5")
            S1.Cells(Satır, 9) = SAYFA.Range("D5")
            S1.Cells(Satır, 10) = SAYFA.Range("E5")
            S1.Cells(Satır, 11) = SAYFA.Range("F5")
            S1.Cells(Satır, 12) = SAYFA.Range("C8")
            S1.Cells(Satır, 13) = SAYFA.Range("D8")
            S1.Cells(Satır, 14) = SAYFA.Range("E8")
            S1.Cells(Satır, 15) = SAYFA.Range("F8")
            S1.Cells(Satır, 16) = SAYFA.Range("J5")
            S1.Cells(Satır, 17) = SAYFA.Range("J6")
            S1.Cells(Satır, 18) = SAYFA.Range("L6")
            Satır = Satır + 1
        End If
    Next
 
    Set S1 = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[numan şamil]

Selamlar Korhan bey
ellerine sağlık kodlar çalıştı bu haliyle işimi görüyor
Yalnız öğrenmek amaçlı soruyorum P sutunu birleştirilmiş hücre olarak aktarmak için kodda negibi değişiklik yapmamız gerekiyor biraz açıklıya bilirmisiniz

 

[Korhan Ayhan]

Selamlar,

Kopyalama yöntemi ile aktarabilirsiniz. Ya da yukarıdaki yöntemle aktarıp sonra hücreleri birleştirme yapabilirsiniz.

 

[numan şamil]

Korhan bey çok teşekkür ederim günlerdir beklediğim cevabı buldum
iyi çalışmalar