Hello all
I have been new to VBA and have been working in it for about 2 weeks. I am trying to aggregate a data set from a folder with multiple workbooks into a single workbook. The code bellow does that but I also want to delete the copied workbook after it is placed in the "Master workbook" any tips would be great. Thank you
'Description: Combines all files 1st sheet in a folder to a master file
Sub MergeFilesWithoutSpaces()
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
ThisWB = ActiveWorkbook.Name
path = ("H:\test")
RowofCopySheet = InputBox("Enter Row to start copy on") ' Row to start on in the sheets you are copying from
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(Cells(Rows.Count, 1).End(xlUp).row, Cells(1, Columns.Count).End(xlToLeft).Column))
Set Dest = shtDest.Range("A" & shtDest.Cells(Rows.Count, 1).End(xlUp).row + 1)
CopyRng.Copy
Dest.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False 'Clear Clipboard
Wkb.Close False
End If
Filename = Dir()
Loop
Range("A1").Select
Columns.AutoFit
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
I have been new to VBA and have been working in it for about 2 weeks. I am trying to aggregate a data set from a folder with multiple workbooks into a single workbook. The code bellow does that but I also want to delete the copied workbook after it is placed in the "Master workbook" any tips would be great. Thank you
'Description: Combines all files 1st sheet in a folder to a master file
Sub MergeFilesWithoutSpaces()
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
ThisWB = ActiveWorkbook.Name
path = ("H:\test")
RowofCopySheet = InputBox("Enter Row to start copy on") ' Row to start on in the sheets you are copying from
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(Cells(Rows.Count, 1).End(xlUp).row, Cells(1, Columns.Count).End(xlToLeft).Column))
Set Dest = shtDest.Range("A" & shtDest.Cells(Rows.Count, 1).End(xlUp).row + 1)
CopyRng.Copy
Dest.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False 'Clear Clipboard
Wkb.Close False
End If
Filename = Dir()
Loop
Range("A1").Select
Columns.AutoFit
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub