HCLamers

Hallo,

De macro werkt en ik heb op dit moment geen vragen meer.

Bedankt voor alle hulp!

Hallo bakerman,

De nieuwe macro werkt perfect! Hartstikke bedankt voor je hulp!

Bedankt voor je reactie en excuses voor mijn late reactie.

Bijgaand een voorbeeld van hoe het eruit moet komen te zien. Inderdaad zoals in jouw voorbeeld.

Ik ga je nieuwe macro toepassen.

Alvast dank!! Als ik nog vragen heb dan hoor je van me.

Overzicht.xlsm

Op 2 januari is er een topic geopend om excel gegevens uit meerdere excel files te extraheren naar 1 general file. De macro die daar gegeven werd is erg handig en heb ik gebruikt voor eigen excel files. Dank voor deze macro! Echter, met deze macro kunnen gegevens uit 1 kolom gehaald worden. Is het mogelijk om de macro zo te schrijven dat er gegevens uit meerdere kolommen gehaald kunnen worden?

In bijgaande voorbeeld-exceldocumenten wil ik bijvoorbeeld de gegevens halen uit kolom G4:G17 en kolom F24:F64. Daarnaast zou ik ook graag de kopjes boven de kolommen hebben. Kan iemand me helpen hoe ik de macro kan aanpassen? Het betreft de volgende macro van Bakerman van 2 januari:

Sub ConsolidateAll()
    Dim rsCon As Object, rsData As Object, sFileName As String
    Dim Prov As String, ExProp As String, resarr ', wDir As String
    Const wDir = "D:\Test2\"
    Prov = IIf(Val(Application.Version) < 12, "Microsoft.Jet.OLEDB.4.0", "Microsoft.ACE.OLEDB.12.0")
    ExProp = IIf(Val(Application.Version) < 12, "8.0", "12.0")
    Sheets(1).Cells(1).CurrentRegion.Offset(1).ClearContents
    sFileName = Dir(wDir & "*.xlsx")
    Do While sFileName <> ""
        If sFileName <> ThisWorkbook.Name Then
            Set rsCon = CreateObject("ADODB.Connection"): Set rsData = CreateObject("ADODB.Recordset")
            rsCon.Open "Provider=" & Prov & ";Data Source=" & wDir & sFileName & _
                            ";Extended Properties=""Excel " & ExProp & ";HDR=No"";"
            rsData.Open "SELECT * FROM [Personalia$B2:B14];", rsCon, 0, 1, 1
            If Not rsData.EOF Then
                resarr = rsData.GetRows
            End If
            Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(resarr, 1) + 1, UBound(resarr, 2) + 1) = resarr
            sFileName = Dir: rsData.Close: Set rsData = Nothing: rsCon.Close: Set rsCon = Nothing
        End If
    Loop
End Sub

voorbeeld1.xlsx voorbeeld3.xlsx voorbeeld2.xlsx