Hallo,
in een map staan excelbestanden met verschillende datum van opslag.
Alleen uit excelbestanden van VOOR een bepaalde datum wil ik de data importeren.
Het importeren van alle excelbestanden was gelukt dmv de "Filename" en een loop.
Nu heb ik geprobeerd om de datum-voorwaarde in de loop toe te voegen door o.a. "FileFSO" te gebruiken en "String" te wijzigen naar "Object", maar dat werkt nog niet.
Ik stoei met de definitie van "String" en "Object" en blijft daarom een foutmelding 91 krijgen.
Ik heb nu de volgende code:
Hopelijk kan iemand me verder helpen.
in een map staan excelbestanden met verschillende datum van opslag.
Alleen uit excelbestanden van VOOR een bepaalde datum wil ik de data importeren.
Het importeren van alle excelbestanden was gelukt dmv de "Filename" en een loop.
Nu heb ik geprobeerd om de datum-voorwaarde in de loop toe te voegen door o.a. "FileFSO" te gebruiken en "String" te wijzigen naar "Object", maar dat werkt nog niet.
Ik stoei met de definitie van "String" en "Object" en blijft daarom een foutmelding 91 krijgen.
Ik heb nu de volgende code:
Code:
Private Sub MT_CopyDataWorkbooksIntoMaster()
Dim FolderPath As String
Dim FileFSO As Object
Dim Filepath As Object
Dim Filename As Object
FolderPath = "C:\Mijn Documenten\Excel\PLANNINGEN - TEST\"
Set FileFSO = CreateObject("Scripting.FileSystemObject")
Set FileFolder = FileFSO.GetFolder(FolderPath)
Set Filepath = FolderPath & "*.xls*"
Set Filename = Dir(Filepath)
Dim lastrow As Long, lastcolumn As Long
Do While Filename <> "" And Format(Filename.DateLastModified, "DD-MM-YYYY") < Format(DateValue("01-12-2017"), "DD-MM-YYYY")
'Werkmap openen
Workbooks.Open (FolderPath & Filename), UpdateLinks:=3, Notify:=False
'Alle Kolommen zichtbaar maken
ActiveSheet.Cells.EntireColumn.Hidden = False
'Laatste Rij vinden
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Kolommen met ProjectNummer en ProjectNaam
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").FormulaR1C1 = "=R1C4"
Range("B1").FormulaR1C1 = "=R2C4"
Range("A1:B1").AutoFill Destination:=Range(Cells(1, 1), Cells(lastrow, 2)), Type:=xlFillDefault
'Laatste Kolom vinden
lastcolumn = ActiveSheet.Cells(4, Columns.Count).End(xlToLeft).Column
'Range(“A6:**”) kopieren en werkmap sluiten
Range(Cells(6, 1), Cells(lastrow, lastcolumn)).Copy
ActiveWorkbook.Close
erow = Blad1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
ActiveSheet.Paste Destination:=Worksheets("Blad1").Range(Cells(erow, 1), Cells(erow, lastcolumn))
Filename = Dir
Loop
Hopelijk kan iemand me verder helpen.