De bedoeling van de macro:
Data uit verschillende werkboeken in één werkboek plaatsen. Alle werkboeken hebben dezelfde sheets en kolommen.
Probleem:
De data vanuit de verschillende werkboeken krijg ik niet gekopieerd. Ik vermoed dat het probleem ligt bij de combinatie For Each en Function Selectionner_Fichiers.
Maar ik loop vast hoe ik dit moet wijzigen. Ondertussen snuister ik verder rond.
Extra info:
De data dient uit de opgegeven worksheets te komen, elk werkboek beschikt nog over andere worksheets.
Code dat ik tot nu toe heb:
Data uit verschillende werkboeken in één werkboek plaatsen. Alle werkboeken hebben dezelfde sheets en kolommen.
Probleem:
De data vanuit de verschillende werkboeken krijg ik niet gekopieerd. Ik vermoed dat het probleem ligt bij de combinatie For Each en Function Selectionner_Fichiers.
Maar ik loop vast hoe ik dit moet wijzigen. Ondertussen snuister ik verder rond.
Extra info:
De data dient uit de opgegeven worksheets te komen, elk werkboek beschikt nog over andere worksheets.
Code dat ik tot nu toe heb:
HTML:
Sub Verzamel_data()
Dim N As Workbook
Dim wb As Workbook
Dim IC As Worksheet
Dim IA As Worksheet
Dim EC As Worksheet
Dim EA As Worksheet
Dim vFichiers As Variant 'variabel verschillende excelfiles
Dim Row As Long
Set N = ThisWorkbook
Set IC = Worksheets("Internal Control")
Set IA = Worksheets("Internal Audit")
Set EC = Worksheets("External Control")
Set EA = Worksheets("External Audit")
'Verwijder voorgaande gegevens in nationale file
N.Activate
IC.Select
Row = IC.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
IC.Range("A7:X" & Row).Clear
IA.Select
Row = IA.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
IA.Range("A7:X" & Row).Clear
EC.Select
Row = EC.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
IC.Range("A7:X" & Row).Clear
EA.Select
Row = EA.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
IA.Range("A7:X" & Row).Clear
'open de gewenste werkboeken
vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler")
'Plaats op te halen gegevens in een loop
For Each wb In Application.Workbooks
'Op te halen gegevens:
'Selecteer gegevens IC en kopieer naar nationale file sheets IC
wb.Activate
Row = IC.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
IC.Range("A7:X" & Row).Copy
N.Activate
Row = IC.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
IC.Range("A" & Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Selecteer gegevens IA en kopieer naar nationale file sheets IA
wb.Activate
Row = IA.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
IA.Range("A7:X" & Row).Copy
N.Activate
Row = IA.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
IA.Range("A" & Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Selecteer gegevens EC en kopieer naar nationale file sheets EC
wb.Activate
Row = EC.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
EC.Range("A7:X" & Row).Copy
N.Activate
Row = EC.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
EC.Range("A" & Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Selecteer gegevens EA en kopieer naar nationale file sheets EA
wb.Activate
Row = EA.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
EA.Range("A7:X" & Row).Copy
N.Activate
Row = EA.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row
EA.Range("A" & Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next wb
End Sub
Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean
sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
End Function