How to combine workbooks from their actual start values (no appending) - vba

Question

I’m really sorry if this is a silly question but the macro I’m currently using keeps appending the new workbooks data when I’m combining them.
Ideally, I want the new workbook to be beside it at cells AA1 instead of directly appending like it is in the picture. I’m sorry I can’t be much more help. I’ve been going through it trying to get it to start for the other workbooks to not append but write where it actually is from the other workbooks. No luck so far.
I’m sure I’ll get there in a few hours or so, but thanks again if you’re willing to assist.
Option Explicit
Public Sub CombineManyWorkbooksIntoOneWorksheet()
Dim strDirContainingFiles As String, strFile As String, _
strFilePath As String
Dim wbkDst As Workbook, wbkSrc As Workbook
Dim wksDst As Worksheet, wksSrc As Worksheet
Dim lngIdx As Long, lngSrcLastRow As Long, _
lngSrcLastCol As Long, lngDstLastRow As Long, _
lngDstLastCol As Long, lngDstFirstFileRow As Long
Dim rngSrc As Range, rngDst As Range, rngFile As Range
Dim colFileNames As Collection
Set colFileNames = New Collection
'Set references up-front
strDirContainingFiles = "C:\Users\Guide\Projects\" '<~ your folder
Set wbkDst = Workbooks.Add '<~ Dst is short for destination
Set wksDst = wbkDst.ActiveSheet
'Store all of the file names in a collection
strFile = Dir(strDirContainingFiles & "\*.xlsm")
Do While Len(strFile) > 0
colFileNames.Add Item:=strFile
strFile = Dir
Loop
''CHECKPOINT: make sure colFileNames has the file names
'Dim varDebug As Variant
'For Each varDebug In colFileNames
' Debug.Print varDebug
'Next varDebug
'Now we can start looping through the "source" files
'and copy their data to our destination sheet
For lngIdx = 1 To colFileNames.Count
'Assign the file path
strFilePath = strDirContainingFiles & "\" & colFileNames(lngIdx)
'Open the workbook and store a reference to the data sheet
Set wbkSrc = Workbooks.Open(strFilePath)
Set wksSrc = wbkSrc.Worksheets("Sheet1")
'Identify the last row and last column, then
'use that info to identify the full data range
lngSrcLastRow = LastOccupiedRowNum(wksSrc)
lngSrcLastCol = LastOccupiedColNum(wksSrc)
With wksSrc
Set rngSrc = .Range(.Cells(1, 1), .Cells(lngSrcLastRow, _
lngSrcLastCol))
End With
''CHECKPOINT: make sure we have the full source data range
'wksSrc.Range("A1").Select
'rngSrc.Select
'If this is the first (1st) loop, we want to keep
'the header row from the source data, but if not then
'we want to remove it
If lngIdx <> 1 Then
Set rngSrc = rngSrc.Offset(1, 0).Resize(rngSrc.Rows.Count - 1)
End If
''CHECKPOINT: make sure that we remove the header row
''from the source range on every loop that is not
''the first one
'wksSrc.Range("A1").Select
'rngSrc.Select
'Copy the source data to the destination sheet, aiming
'for cell A1 on the first loop then one past the
'last-occupied row in column A on each following loop
If lngIdx = 1 Then
lngDstLastRow = 1
Set rngDst = wksDst.Cells(1, 1)
Else
lngDstLastRow = LastOccupiedRowNum(wksDst)
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
End If
rngSrc.Copy Destination:=rngDst '<~ this is the copy / paste
'Almost done! We want to add the source file info
'for each of the data blocks to our destination
'On the first loop, we need to add a "Source Filename" column
If lngIdx = 1 Then
lngDstLastCol = LastOccupiedColNum(wksDst)
wksDst.Cells(1, lngDstLastCol + 1) = "Source Filename"
End If
'Identify the range that we need to write the source file
'info to, then write the info
With wksDst
'The first row we need to write the file info to
'is the same row where we did our initial paste to
'the destination file
lngDstFirstFileRow = lngDstLastRow + 1
'Then, we need to find the NEW last row on the destination
'sheet, which will be further down (since we pasted more
'data in)
lngDstLastRow = LastOccupiedRowNum(wksDst)
lngDstLastCol = LastOccupiedColNum(wksDst)
'With the info from above, we can create the range
Set rngFile = .Range(.Cells(lngDstFirstFileRow, lngDstLastCol), _
.Cells(lngDstLastRow, lngDstLastCol))
''CHECKPOINT: make sure we have correctly identified
''the range where our file names will go
'wksDst.Range("A1").Select
'rngFile.Select
'Now that we have that range identified,
'we write the file name
rngFile.Value = wbkSrc.Name
End With
'Close the source workbook and repeat
wbkSrc.Close SaveChanges:=False
Next lngIdx
'Let the user know that the combination is done!
''MsgBox "Data combined!"
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Sheet, the worksheet we'll search to find the last row
'OUTPUT : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
Else
lng = 1
End If
LastOccupiedRowNum = lng
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Sheet, the worksheet we'll search to find the last column
'OUTPUT : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End With
Else
lng = 1
End If
LastOccupiedColNum = lng
End Function

Answer 1

You should identify the individual tasks that you program will have to perform and create methods and functions to handle these smaller tasks. Doing this will allow you to easily debug your code.
get1stCellInNextColumn - Defines the Target range
getFileCollection - Collect all the file paths
getLastUsedCell - Gets the last used cell in a range. Used to define both Source and Target ranges
getSourceRange - Gets the Source Range
InsertData - Opens a Source file and copies its data to a Target Workbook
Main_CombineManyWorkbooksIntoOneWorksheet - Process all the files
Option Explicit
'This is the Main function that combines all the other Subs and Functions together to process the data
Public Sub Main_CombineManyWorkbooksIntoOneWorksheet()
Application.ScreenUpdating = False
Const FOLDERNAME As String = "C:\Users\best buy\Downloads\_Temp\" ' "C:\Users\Guide\"
Const EXTENSION As String = "\*.xlsx" '"\*.xlsm"
Dim cFiles As Collection
Dim x As Long
Set cFiles = getFileCollection(FOLDERNAME, EXTENSION)
With Workbooks.Add
For x = 1 To cFiles.Count
InsertData cFiles.Item(x), .Worksheets(1)
Next
End With
Application.ScreenUpdating = True
End Sub
'Opens Source Workbook, Copies Data to Target Worksheet and then closes the Source Workbook
Public Sub InsertData(SourceWBName As String, TargetWS As Worksheet)
Dim rSource As Range
With Workbooks.Open(SourceWBName)
Set rSource = getSourceRange(.Worksheets("Sheet1"))
If rSource Is Nothing Then
Debug.Print .FullName, "No Data Found"
Else
rSource.Copy get1stCellInNextColumn(TargetWS.UsedRange)
End If
.Close SaveChanges:=False
End With
End Sub
'Collects the full file paths for the Source workbooks
Function getFileCollection(FOLDERNAME As String, FileExtension As String) As Collection
Dim FileName As String
Dim col As Collection
Set col = New Collection
'Store all of the file names in a collection
FileName = Dir(FOLDERNAME & FileExtension)
Do While Len(FileName) > 0
col.Add Item:=FOLDERNAME & FileName
FileName = Dir
Loop
Set getFileCollection = col
End Function
'Gets the Source range from a Worksheet
Function getSourceRange(xlWS As Worksheet) As Range
Dim rLastCell As Range
With xlWS
Set rLastCell = getLastUsedCell(.UsedRange, True, True)
If Not rLastCell Is Nothing Then Set getSourceRange = .Range(.Cells(1, 1), rLastCell)
End With
End Function
'Gets the first cell in the next unused Column of the Target range
Function get1stCellInNextColumn(Target As Range) As Range
Dim r As Range
'Get last used cell in last used column of the Target range
Set r = getLastUsedCell(Target, False, True)
If r Is Nothing Then
Set r = Target.EntireColumn.Cells(1, 1)
Else
'Get the first cell in the next column adjacent to the Target range
Set r = Target.Columns(Target.Columns.Count).Next
End If
Set get1stCellInNextColumn = r
End Function
'Gets the last used cell the last used row
'Or the last used cell the last used column
'Or the last used cells in the Target range
Function getLastUsedCell(Target As Range, InRow As Boolean, InColumn As Boolean) As Range
Dim rRow As Range, rColumn As Range
If Target Is Nothing Then Exit Function
With Target
Set rRow = .Find(What:="*", After:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
If rRow Is Nothing Then Exit Function
Set rColumn = .Find(What:="*", After:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
If InRow And InColumn Then 'Get last used cell in last used column
Set getLastUsedCell = Intersect(rRow.EntireRow, rColumn.EntireColumn)
ElseIf InRow Then 'Get last used cell in last used row
Set getLastUsedCell = rRow
ElseIf InColumn Then 'Get last used cell in last used column
Set getLastUsedCell = rColumn
End If
End With
End Function

Answer 2

Sorry to answer my own question but I figured it out after a bit of debugging. The following code below does not append and creates the excels exactly as you need them. Change the values as you see fit or use original code if you need to append.
Option Explicit
Public Sub CombineManyWorkbooksIntoOneWorksheet()
Dim strDirContainingFiles As String, strFile As String, _
strFilePath As String
Dim wbkDst As Workbook, wbkSrc As Workbook
Dim wksDst As Worksheet, wksSrc As Worksheet
Dim lngIdx As Long, lngSrcLastRow As Long, _
lngSrcLastCol As Long, lngDstLastRow As Long, _
lngDstLastCol As Long, lngDstFirstFileRow As Long
Dim rngSrc As Range, rngDst As Range, rngFile As Range
Dim colFileNames As Collection
Set colFileNames = New Collection
'Set references up-front
strDirContainingFiles = "C:\Users\Guide\" '<~ your folder
Set wbkDst = Workbooks.Add '<~ Dst is short for destination
Set wksDst = wbkDst.ActiveSheet
'Store all of the file names in a collection
strFile = Dir(strDirContainingFiles & "\*.xlsm")
Do While Len(strFile) > 0
colFileNames.Add Item:=strFile
strFile = Dir
Loop
''CHECKPOINT: make sure colFileNames has the file names
'Dim varDebug As Variant
'For Each varDebug In colFileNames
' Debug.Print varDebug
'Next varDebug
'Now we can start looping through the "source" files
'and copy their data to our destination sheet
For lngIdx = 1 To colFileNames.Count
'Assign the file path
strFilePath = strDirContainingFiles & "\" & colFileNames(lngIdx)
'Open the workbook and store a reference to the data sheet
Set wbkSrc = Workbooks.Open(strFilePath)
Set wksSrc = wbkSrc.Worksheets("Sheet1")
'Identify the last row and last column, then
'use that info to identify the full data range
lngSrcLastRow = LastOccupiedRowNum(wksSrc)
lngSrcLastCol = LastOccupiedColNum(wksSrc)
With wksSrc
Set rngSrc = .Range(.Cells(1, 1), .Cells(lngSrcLastRow, _
lngSrcLastCol))
End With
''CHECKPOINT: make sure we have the full source data range
'wksSrc.Range("A1").Select
'rngSrc.Select
'If this is the first (1st) loop, we want to keep
'the header row from the source data, but if not then
'we want to remove it
''CHECKPOINT: make sure that we remove the header row
''from the source range on every loop that is not
''the first one
'wksSrc.Range("A1").Select
'rngSrc.Select
'Copy the source data to the destination sheet, aiming
'for cell A1 on the first loop then one past the
'last-occupied row in column A on each following loop
If lngIdx = 1 Then
lngDstLastRow = 1
Set rngDst = wksDst.Cells(1, 1)
Else
lngDstLastRow = 1
Set rngDst = wksDst.Cells(1, 20)
End If
rngSrc.Copy Destination:=rngDst '<~ this is the copy / paste
'Close the source workbook and repeat
wbkSrc.Close SaveChanges:=False
Next lngIdx
'Let the user know that the combination is done!
''MsgBox "Data combined!"
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Sheet, the worksheet we'll search to find the last row
'OUTPUT : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
Else
lng = 1
End If
LastOccupiedRowNum = lng
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Sheet, the worksheet we'll search to find the last column
'OUTPUT : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End With
Else
lng = 1
End If
LastOccupiedColNum = lng
End Function