Macro samenvoegen bestanden aan de hand van een button

[brandon93]

Goedemorgen allen,

Ik heb het forum en google al doorgezocht voor het ontwikkelen van mijn macro, maar ik kom er niet uit.
Hopelijk kunnen jullie mij helpen met het volgende.

Ik heb een map met daarin excel bestanden. In deze map worden iedere maand nieuwe excel bestanden toegevoegd.

Nu is mijn bedoeling het volgende:
De macro uitvoeren aan de hand van het klikken op een knop (die op blad 1 staat)
Vervolgens moet de macro het volgende doen:
- In blad 2 vanaf kolom B alle bestanden samenvoegen (onder elkaar zetten) die in de map staan.(in kolom A staat een formule)
- Slechts 1 keer moet de eerste rij (header) worden overgenomen

Is het mogelijk wat ik wil?

Alvast bedankt voor jullie hulp!

Groeten, Brandon

 

[OctaFish]

Je bent niet heel erg duidelijk, vrees ik. En volgens mij heb je het idee nog niet helemaal goed uitgewerkt. Het is op zich niet zo moeilijk om vanuit bestand A werkbladen uit andere werkboeken in te lezen, maar zoals jij het beschrijft krijg je een enorm werkblad waarin elke keer als je kop de knop klikt alle bestanden opnieuw worden ingelezen. En dat zal toch niet de bedoeling zijn? Ik neem toch aan dat een bestand maar één keer ingelezen wordt, en daarna niet meer?

 

[brandon93]

Je bent niet heel erg duidelijk, vrees ik. En volgens mij heb je het idee nog niet helemaal goed uitgewerkt. Het is op zich niet zo moeilijk om vanuit bestand A werkbladen uit andere werkboeken in te lezen, maar zoals jij het beschrijft krijg je een enorm werkblad waarin elke keer als je kop de knop klikt alle bestanden opnieuw worden ingelezen. En dat zal toch niet de bedoeling zijn? Ik neem toch aan dat een bestand maar één keer ingelezen wordt, en daarna niet meer?

Ik zou inderdaad graag een enorm werkblad willen waarin elke keer met een druk op de knop alle bestanden opnieuw worden ingelezen (een refresh dus).

Huidig heb ik onderstaande code:

Sub samenvoeg()
For Each fl In CreateObject("scripting.filesystemobject").getfolder("N:\").Files
If Right(fl.Name, 4) = ".xls" Then
With Workbooks.Add(fl)
sq = .Sheets("1075781 tc").UsedRange
.Close False
End With
ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sq), UBound(sq, 2)) = sq
End If
Next
End Sub

Echter zoekt deze macro op specifiek tabblad dat in mijn geval niet aan de orde is, zet op te halen gegevens in verkeerde kolom/tablad en zit er nog geen button in.

 

[OctaFish]

Omdat goed citeren beter is als slecht jatten, hier een pagina met 2 codevoorbeelden. Code ziet er bruikbaar uit .
En graag niet meer quooten als het niet nodig is; de quoot van mijn vorige berichtje is dat overduidelijk wel (nodeloos dus )

 

[brandon93]

Excusus ik heb niet veel ervaring met macro's, maar wil nu de volgende macro hanteren en krijg tijdens uitvoering de fout 1004:

'Description: Combines all files in a folder to a master file.
Sub MergeFiles()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer

    RowofCopySheet = 2 ' Row to start on in the sheets you are copying from

    ThisWB = ActiveWorkbook.Name
    
    path = ("N:\")

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
            Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
            Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
            CopyRng.Copy Dest
            Wkb.Close False
        End If
        
        Filename = Dir()
    Loop

    Range("A1").Select
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    MsgBox "Done!"
End Sub

Graag hoor ik wat ik fout doe?

 

[brandon93]

Opgelost!
Dus kan dicht.

 

[OctaFish]

Het is fijn voor jou dat je het probleem hebt opgelost, maar de lezer kan niet zoveel met zo'n opmerking. Geef dus nog even aan waar de fout in de code zat, en bij voorkeur uiteraard ook de code aanpassen . Lezers willen voorbeeldjes nog wel eens kopiëren, en dan liefst werkend zonder fouten .