1000 Excel Dosyasından Belli Sütunu Yeni Excel Dosyasına Taşımak

[AntiClient]

Merhabalar,

Şöyle bir sıkıntım çıktı. Benim 1000 adet 1000 satırlı excel dosyam var.

Hepsinin f sutununda veriler var. Bazı satırlar da boş. Benim istediğim bu verileri tek bi excelde toplayabilmek. Yani F sutununu alıp, yeni excelde A sütununa yazmak, bir sonrakinde B sütununa yazdırmak. Yanyana gelecek şekilde yazdırmanın bir yolu var mıdır acaba? teşekkürler şimdiden.

 

[arşivist1]

forumda kapalı dosyadan veri almak hakkında güzel bir konu var.
incelerseniz işinize yarar birşey belki bulursunuz.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu boş bir dosyaya uygulayın.

İlgili klasörü seçip işlemin tamamlanmasını bekleyin.

Masaüstünde "Konsolide Dosya Sistem Saati" adıyla yeni dosya oluşmuş olacaktır.

İşlem 2 dakika kadar sürebilir.

Option Explicit

Sub KLASORDEKI_DOSYALARIN_F_SUTUNUNU_YENI_DOSYAYA_YANYANA_AKTAR()
    Dim Klasor As Object, Dosya As String, Kitap As Workbook
    Dim Yeni_Kitap As Workbook, Sutun As Integer, Dosya_Adi As String, Zaman As Date
        
    Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör seçiniz !", 1)
    If Klasor Is Nothing Then Exit Sub
    
    Zaman = Time
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    
    Set Yeni_Kitap = Workbooks.Add(1)
    Sutun = 1
    
    Dosya = Dir(Klasor.Self.Path & "\*.*")
    
    While Dosya <> ""
        Set Kitap = Workbooks.Open(Klasor.Self.Path & "\" & Dosya, False, False)
        DoEvents
        Kitap.Sheets(1).Range("F1:F1000").Copy
        Yeni_Kitap.Sheets(1).Cells(1, Sutun).PasteSpecial xlValues
        Application.CutCopyMode = False
        Sutun = Sutun + 1
        Kitap.Close 0
        Dosya = Dir
    Wend
    
    Dosya_Adi = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Konsolide Dosya " & Format(Time, "hhmmss")
    Yeni_Kitap.SaveAs Dosya_Adi
    Yeni_Kitap.Close
    
    Set Klasor = Nothing

    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
        
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Time - Zaman, "hh:mm:ss"), vbInformation
End Sub

 

[AntiClient]

ellerinize sağlık, çok büyük yükten kurtardınız beni. şimdi kullanma imkanım oldu.

 

[gavara]

peki f değilde a,b,c,d ki leri başka bir excel'in a,b,c,d sine nasıl yapabiliriz

 

[Korhan Ayhan]

Örnek dosyalarınızı eklerseniz çözüm sunabiliriz.