İki ayrı dosyadaki verileri tek dosyada alt alta birleştirme

[mekist]

Merhaba,

İki ayrı dosyam var içerisindeki bilgileri tek excel kitabında birleştirmek istiyorum. önce festival olan dosyadakiler gelsin daha sonrada dentmed'deki dosyadaki veriler alt alta gelecek şekilde yeni bir kitapta birleştirmek istiyorum.
Örnek dosyalara baktım ama uyarlayamadım.
Yardımcı olabilir misiniz.

 

[Necdet]

Merhaba,

Tam 2 ay sonra yanıt alıyorsunuz. Bunun nedeni sorunuzu ilgili olmayan yerde sormanız.

Konu tarafımdan Makro bölümüne aktarıldı.

Sorunuzun çözümüne gelince, bir çok çözüm yolu olabilir. Ben şöyle düşündüm :

1 yada 2 dosya ile sınırlı kalmamak için birleştirilecek dosyaları seçerek tamam dediğinizde ListBoxa alıp Listboxta çift tıkladığınız dosyayı ilgili dosyaya aktarır.

Private Sub CommandButton1_Click()
    ListBox1.Clear
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim SecilenDosyalar As Variant
    With fd
        .Filters.Clear
'        .Filters.Add "All files", "*.*"
        .Filters.Add "Excel Dosyaları", "*.xls; *.xls; *.xlsx", 1
        If .Show = -1 Then
            For Each SecilenDosyalar In .SelectedItems
                ListBox1.AddItem SecilenDosyalar
            Next SecilenDosyalar
        Else
            MsgBox "Hiç Bir Dosya Seçmediniz"
        End If
    End With
    Set fd = Nothing
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
Dim DB As ADODB.Connection
Dim RS As ADODB.Recordset
Dim SQLStr As String
Set DB = New ADODB.Connection
MyPath = ListBox1.Value
DB.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & MyPath
Set RS = New ADODB.Recordset
RS.CursorLocation = adUseClient
RS.CursorType = adOpenDynamic
RS.LockType = adLockOptimistic
SQLStr = "SELECT * FROM [Sayfa1$]"
RS.Open SQLStr, DB, 1, 3
Range("A" & [A65536].End(3).Row + 1).CopyFromRecordset RS
DB.Close
Set DB = Nothing
Set RS = Nothing
 
Application.ScreenUpdating = True
End Sub

 

[mekist]

Öncelikle yanlış yerde açtığım için özür dilerim.
Affınıza sığınıyorum.

Ellerine sağlık mükkemel bir çalışma olmuş.Çok teşekkür ederim.
Allah razı olsun.

 

[serdem48]

Merhaba,

Tam 2 ay sonra yanıt alıyorsunuz. Bunun nedeni sorunuzu ilgili olmayan yerde sormanız.

Konu tarafımdan Makro bölümüne aktarıldı.

Sorunuzun çözümüne gelince, bir çok çözüm yolu olabilir. Ben şöyle düşündüm :

1 yada 2 dosya ile sınırlı kalmamak için birleştirilecek dosyaları seçerek tamam dediğinizde ListBoxa alıp Listboxta çift tıkladığınız dosyayı ilgili dosyaya aktarır.

Private Sub CommandButton1_Click()
    ListBox1.Clear
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim SecilenDosyalar As Variant
    With fd
        .Filters.Clear
'        .Filters.Add "All files", "*.*"
        .Filters.Add "Excel Dosyaları", "*.xls; *.xls; *.xlsx", 1
        If .Show = -1 Then
            For Each SecilenDosyalar In .SelectedItems
                ListBox1.AddItem SecilenDosyalar
            Next SecilenDosyalar
        Else
            MsgBox "Hiç Bir Dosya Seçmediniz"
        End If
    End With
    Set fd = Nothing
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
Dim DB As ADODB.Connection
Dim RS As ADODB.Recordset
Dim SQLStr As String
Set DB = New ADODB.Connection
MyPath = ListBox1.Value
DB.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & MyPath
Set RS = New ADODB.Recordset
RS.CursorLocation = adUseClient
RS.CursorType = adOpenDynamic
RS.LockType = adLockOptimistic
SQLStr = "SELECT * FROM [Sayfa1$]"
RS.Open SQLStr, DB, 1, 3
Range("A" & [A65536].End(3).Row + 1).CopyFromRecordset RS
DB.Close
Set DB = Nothing
Set RS = Nothing
 
Application.ScreenUpdating = True
End Sub

elinize saglık çok güzel bir çalışma bu işe yarayan bir çalışma bende yaptım ama ikisi arasında daglar yollar denizler kadar fark var
neticede aynı işi yapıyor ama bu daha zahmetsiz ve dertsiz.

 

[Forced]

Bu dosyadaki sütun etiketlerini ve sütun sayısını kendimize göre uygun hale getirmemiz mümkün müdür?