Sütunlardaki verileri aktarma

[Erdinç FIRTINA]

Değerli Forum üyeleri,

kapalı durumda olan dosyaların belirlenen sayfalarında(örneğin 2 nolu sayfa) belirlenen alanlarındaki verileri(örneğin d5-d10 arası) adı belirlenen bir dosyanın 3 nolu sayfasında belirlenen herhangi bir sütundan başlayarak örneğin c5 ten başlayarak alt alta nasıl birleştirebilirim ?

Yardımlarınız için şimdiden teşekkürler ...

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Sub Verileri_Aktar()
    Dim Ana_Dosya As Workbook
    Dim Veri_Dosyasi As Workbook
    Dim Yol As String
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim Kitap As String
    Dim Satir As Long
    
    Set Ana_Dosya = ThisWorkbook
    Set S1 = Ana_Dosya.Sheets("Sayfa3")
    Yol = Ana_Dosya.Path
    
    S1.Range("C5:C" & Rows.Count).Clear
    Satir = 5
    
    Kitap = Dir(Yol & "\*.xls*")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    While Kitap <> "" And Ana_Dosya.Name <> Kitap
        Set Veri_Dosyasi = Workbooks.Open(Yol & "\" & Kitap)
        Set S2 = Veri_Dosyasi.Sheets("2")
        S2.Range("D5:D10").Copy S1.Cells(Satir, 3)
        Satir = S1.Cells(Rows.Count, 3).End(3).Row + 1
        If Satir < 5 Then Satir = 5
        Veri_Dosyasi.Close 0
        Kitap = Dir
    Wend

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Erdinç FIRTINA]

Sayın Korhan Ayhan,

Çok çok teşekkür ederim.