Hi all,
I recently made a post about having multiple workbooks, all located in the same folder, and wanting to merge them into a singular workbook while maintaing the template that all of the workbooks shared.
I got a superb piece of code from JBeaucaire that solved all of my problems. However, I am now having a small issue with the code.
The code is designed to look UP the "C" column to spot the last row of data for the LR variable. However, column C is not always filled. there is no Column in the worksheet that is consistently filled out throughout. But, there is always data in either Column C or Column D. How can I edit the code to check both column C and D to spot the last row of data for the LR variable.
Option Explicit
Sub ConsolidateSheetsFromWorkbooks()
'Author: Jerry Beaucaire, ExcelForum.com
'Date: 1/5/2011
'Summary: Open all files in a folder and merge data (stacked) on all
' sheets into main wb matching the sheet names.
' Assumes all sheets with titles exist in main book and
' data sheets data starts at row 2
Dim wbData As Workbook, wbMain As Workbook
Dim wsMain As Worksheet, wsData As Worksheet
Dim LR As Long, NR As Long
Dim fPath As String, fName As String
Set wbMain = ThisWorkbook
'if files are stored in separate directory edit fPath
MsgBox "Please select a folder with files to consolidate"
Do
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
fPath = .SelectedItems(1) & "\"
Exit Do
Else
If MsgBox("No folder chose, do you wish to abort?", _
vbYesNo) = vbYes Then Exit Sub
End If
End With
Loop
'don't forget the final \
fName = Dir(fPath & "*.xls") 'start looping through files one at a time
Application.ScreenUpdating = False
Do While Len(fName) > 0
If fName <> ThisWorkbook.Name Then
Set wbData = Workbooks.Open(fPath & fName)
For Each wsData In wbData.Worksheets
Set wsMain = wbMain.Sheets(wsData.Name)
NR = wsMain.Range("C" & Rows.Count).End(xlUp).Row + 1
With wsData
LR = .Range("C" & .Rows.Count).End(xlUp).Row
If LR > 5 Then .Range("C6:C" & LR).EntireRow.Copy wsMain.Range("A" & NR)
End With
Next wsData
wbData.Close False
End If
fName = Dir 'queue up next filename
Loop
Application.ScreenUpdating = True
End Sub
I'm still very new at this so thank you for your patience!
Bookmarks