rimcus
01-29-2021, 08:26 AM
Hello everyone,
I want to create a database of my old clients from the quotes I've made in the past. To do so I thought about merging all the workbooks in one (Every quote has 3 worksheets, only one is filled), then filling the database with the key informations thanks to the INDIRECT command.
The Problem is that I have many files and cant merge them manually, and I'm using a mac so can't do it with power query, I tried many VBA codes I found online with no results. All the workbooks are in the same file. Here's an example of a code I found in this forum :
Public Sub ConslidateWorkbooks()Dim this As Workbook
Dim Sheet As Worksheet
Dim Nextcell As Range
Dim FolderPath As String
Dim Filename As String
Dim Lastrow As Long
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "\Documents\Reports\"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Call SheetExists(Sheet.Name, ThisWorkbook, True)
Lastrow = ThisWorkbook.Worksheets(Sheet.Name).Range("A1").SpecialCells(xlCellTypeLastCell).Row
If Lastrow = 1 And ThisWorkbook.Worksheets(Sheet.Name).Range("A1").Value = vbNullString Then Lastrow = 0
Sheet.UsedRange.Copy ThisWorkbook.Worksheets(Sheet.Name).Cells(Lastrow + 1, "A")
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Public Function SheetExists( _
ByVal Name As String, _
Optional ByRef Wb As Workbook, _
Optional ByVal Create As Boolean = False) As Boolean
Dim res As Boolean
If Wb Is Nothing Then Set Wb = ActiveWorkbook
On Error Resume Next
res = CBool(Not Wb.Worksheets(Name) Is Nothing)
If Not res And Create Then
Wb.Worksheets.Add After:=Wb.Worksheets(Wb.Worksheets.Count)
Wb.Worksheets(Wb.Worksheets.Count).Name = Name
End If
SheetExists = res End Function
Thank you for reading me
I want to create a database of my old clients from the quotes I've made in the past. To do so I thought about merging all the workbooks in one (Every quote has 3 worksheets, only one is filled), then filling the database with the key informations thanks to the INDIRECT command.
The Problem is that I have many files and cant merge them manually, and I'm using a mac so can't do it with power query, I tried many VBA codes I found online with no results. All the workbooks are in the same file. Here's an example of a code I found in this forum :
Public Sub ConslidateWorkbooks()Dim this As Workbook
Dim Sheet As Worksheet
Dim Nextcell As Range
Dim FolderPath As String
Dim Filename As String
Dim Lastrow As Long
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "\Documents\Reports\"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Call SheetExists(Sheet.Name, ThisWorkbook, True)
Lastrow = ThisWorkbook.Worksheets(Sheet.Name).Range("A1").SpecialCells(xlCellTypeLastCell).Row
If Lastrow = 1 And ThisWorkbook.Worksheets(Sheet.Name).Range("A1").Value = vbNullString Then Lastrow = 0
Sheet.UsedRange.Copy ThisWorkbook.Worksheets(Sheet.Name).Cells(Lastrow + 1, "A")
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Public Function SheetExists( _
ByVal Name As String, _
Optional ByRef Wb As Workbook, _
Optional ByVal Create As Boolean = False) As Boolean
Dim res As Boolean
If Wb Is Nothing Then Set Wb = ActiveWorkbook
On Error Resume Next
res = CBool(Not Wb.Worksheets(Name) Is Nothing)
If Not res And Create Then
Wb.Worksheets.Add After:=Wb.Worksheets(Wb.Worksheets.Count)
Wb.Worksheets(Wb.Worksheets.Count).Name = Name
End If
SheetExists = res End Function
Thank you for reading me