kris_friis
New Member
- Joined
- Nov 27, 2020
- Messages
- 8
- Office Version
- 2013
- Platform
- Windows
Hi all,
I have written this code, but I have an issue: When it runs the second time (it should run daily) it deletes the previous data and past the new one from below what it deleted. It should delete the first and then paste from the second row
I have written this code, but I have an issue: When it runs the second time (it should run daily) it deletes the previous data and past the new one from below what it deleted. It should delete the first and then paste from the second row
VBA Code:
Sub MergeFiles()
Worksheets("Copy").Range("A1:AV12000").Clear
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 = "C:\Users\OneDrive\PowerApp"
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xlsx", 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("A2:AV300").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Data is merged"
End Sub
Sub MergeFiles()
Worksheets("Copy").Range("A1:AV12000").Clear
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 = "C:\Users\ksf008\OneDrive - Maersk Group\PowerApp\Mini Database"
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xlsx", 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("A2:AV300").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Data is merged"
End Sub
Last edited by a moderator: