Onderstaande code heb ik de laatste dagen in elkaar geklust (zeg maar geprutst )
wat ik wil en nog niet voor elkaar krijg
is dat voordat de loop begint de range B26 : D40 leeg gemaakt word
en dat de waardes worden geplaatst beginnende op B26 ipv in Kolom E rij 2
Kan iemand me opweg helpen naar de oplossting
wat ik wil en nog niet voor elkaar krijg
is dat voordat de loop begint de range B26 : D40 leeg gemaakt word
en dat de waardes worden geplaatst beginnende op B26 ipv in Kolom E rij 2
Code:
Sub MergeAllWorkbooks()
Dim Reportwb As Workbook
Dim FolderPath As String
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Application.ScreenUpdating = False
' Set summarysheet to activeworkbook/activesheet where the macro runs
Set Reportwb = ThisWorkbook
' Modify this folder path to point to the files you want to use.
FolderPath = "D:\diverse\test\"
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "werkmap *.xl*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)
'loop through all Sheets in WorkBk
' Set the source range to be A1 through C1.
Set SourceRange = Sheets("All").Range("A1:C1")
' Set the destination range to start at column E and
Set DestRange = Reportwb.Sheets("Blad1").Range("E" & Reportwb.Sheets("Blad1").Range("E" & Rows.Count).End(xlUp).Row + 1)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()
Loop
' Call AutoFit on the destination sheet so that all
' data is readable.
ActiveSheet.Columns.AutoFit
End Sub
Kan iemand me opweg helpen naar de oplossting