klasördeki excel dosyalarını birleştirme

[orkunozbudak]

Herkese merhaba klasördeki dosyaları hepsini birleştirmek istiyorum aratma yaptığımda ya sayfalardaki linkler ölmüş yada birleştirmeyi düzgün yapmıyor klasördeki bütün dosyalar aynı formatta hepsini altalta tek sayfa yaparak birleştirmek istiyorum.Sayımda çap ve renk olarak kaç metre gittiğini hesaplamam lazım.Teşekkürler

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.
Yol olarak tanımlanan değişkene dosyaların bulunduğu dizin adını veriniz.

Sub Dosya_Oku_VeriGetir()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Long
Dim lRow As Long
Dim adt As Integer
Dim yol As String
Dim arr As Variant

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

yol = "C:\BURAYA KLASÖR ADINI YAZINIZ"
Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.GetFolder(yol)

For Each oFile In oFolder.Files
    Workbooks.Open (oFolder & Application.PathSeparator & oFile.Name)
    lRow = Sheets(1).Cells(Rows.Count, "A").End(3).Row
    adt = adt + 1
    If adt = 1 Then
        arr = Sheets(1).Range("A1:K" & lRow).Value
    Else
        arr = Sheets(1).Range("A2:K" & lRow).Value
    End If
    ActiveWorkbook.Close Savechanges:=False
    i = Cells(Rows.Count, "A").End(3).Row
    If i = 2 Then i = 1
    Range("A" & i).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
Next oFile

MsgBox adt & " Adet Dosya Okundu..."

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

 

[orkunozbudak]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.
Yol olarak tanımlanan değişkene dosyaların bulunduğu dizin adını veriniz.

Sub Dosya_Oku_VeriGetir()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Long
Dim lRow As Long
Dim adt As Integer
Dim yol As String
Dim arr As Variant

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

yol = "C:\BURAYA KLASÖR ADINI YAZINIZ"
Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.GetFolder(yol)

For Each oFile In oFolder.Files
    Workbooks.Open (oFolder & Application.PathSeparator & oFile.Name)
    lRow = Sheets(1).Cells(Rows.Count, "A").End(3).Row
    adt = adt + 1
    If adt = 1 Then
        arr = Sheets(1).Range("A1:K" & lRow).Value
    Else
        arr = Sheets(1).Range("A2:K" & lRow).Value
    End If
    ActiveWorkbook.Close Savechanges:=False
    i = Cells(Rows.Count, "A").End(3).Row
    If i = 2 Then i = 1
    Range("A" & i).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
Next oFile

MsgBox adt & " Adet Dosya Okundu..."

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

Selamlar öncelikle teşekkür ediyorum ilginize fakat 47 dosya okundu yazdıktan sonra sayfa bomboş kaldı dosyaları birleştirmedi aynı klasör içinde yolu seçtiğim zamanda bütün fonksiyonlar renksizleşiyor

 

[Necdet]

Kodları deneyip verdim.
Yine denedim yine çalıştı.

 

[orkunozbudak]

söyle bir macro bulmustum sıtenizde bundada yol gösterip birleştiriyorum fakat bütün hepsini almıyor yine ben hepsini tek bir excel haline getirmek istiyorum eğer sayı fazla geliyorsa 20 şey dosya olarakta bölebilirim

 

[Necdet]

Benim kodlar 29.275 kayıt getirdi.
Örnek olarak eklediğiniz dosyalarda hep tek sayfa vardı, ben dosyadan 1. sayfanın adına bakmadan çektim.
orijinal dosyalarınızda birden fazla sayfa varsa kodda sayfa adını da belirtmek gerek.

 

[orkunozbudak]

son ekledıgınız dosyada oldu cok tesekkur edıyorum size

 

[Necdet]

büyük olasılıkla dosyaların okunacağı yolu belirtmediniz.

 

[By.TRabZonLutm]

Benim kodlar 29.275 kayıt getirdi.
Örnek olarak eklediğiniz dosyalarda hep tek sayfa vardı, ben dosyadan 1. sayfanın adına bakmadan çektim.
orijinal dosyalarınızda birden fazla sayfa varsa kodda sayfa adını da belirtmek gerek.

hocam bu dosyayı denedim şöyle bir hata veriyor

 

[Necdet]

Örnek dosya eklerseniz durum daha iyi anlaşılır.

 

[bosislermuduru]

Eğer Amacınız Excellleri Birleştirip Bir Tablo Oluşturmaksa Power Query Kullanmanızı Öneririm
Ekteki Exceli indirip Veri Kaynağını Değiştirmeniz Yeterli Olacaktır


Örnek Kod

let
Kaynak = Folder.Files("D:\Yedek\Masaüstü\sayım"),
#"Filtrelenmiş Gizli Dosyalar1" = Table.SelectRows(Kaynak, each [Attributes]?[Hidden]? <> true),
#"Özel İşlev Çağır1" = Table.AddColumn(#"Filtrelenmiş Gizli Dosyalar1", "Dosya Dönüştür", each #"Dosya Dönüştür"([Content])),
#"Yeniden Adlandırılan Sütunlar1" = Table.RenameColumns(#"Özel İşlev Çağır1", {"Name", "Source.Name"}),
#"Kaldırılan Diğer Sütunlar1" = Table.SelectColumns(#"Yeniden Adlandırılan Sütunlar1", {"Source.Name", "Dosya Dönüştür"}),
#"Genişletilen Tablo Sütunu1" = Table.ExpandTableColumn(#"Kaldırılan Diğer Sütunlar1", "Dosya Dönüştür", Table.ColumnNames(#"Dosya Dönüştür"(#"Örnek Dosya")))
in
#"Genişletilen Tablo Sütunu1"