Private Sub cbConsolidateOpportunities_Click() Dim Folder As String, File As String Dim lSrcLastRow As Long Dim Last As Long Dim Temp As Long Dim SrcRows As Long Dim CopyRng As Range Dim SrcWkb As Workbook Dim objXls As Object Dim objWrkBk As Object Dim DstWks As Worksheet Dim SrcWks As Worksheet Dim IMTWks As Worksheet Dim logWks As Worksheet Dim lLogLastRow As Long Folder = ThisWorkbook.Path With Application.FileSearch .LookIn = Folder .filename = "*Account Planning Template*.xls" .FileType = msoFileTypeExcelWorkbooks .SearchSubFolders = False .Execute If .Execute > 0 Then Set DstWks = ThisWorkbook.Worksheets("Consolidated") Set logWks = ThisWorkbook.Worksheets("Log") On Error GoTo ErrSub For i = 1 To .FoundFiles.Count File = .FoundFiles(i) Set SrcWkb = Workbooks.Open(.FoundFiles(i)) Set SrcWks = SrcWkb.Worksheets("Opportunities") Set IMTWks = SrcWkb.Worksheets("Account Financials") lSrcLastRow = Worksheets("Opportunities").Range("D65536").End(xlUp).Row ' Find the last row with data on the summary worksheet. Last = DstWks.Range("B65536").End(xlUp).Row If Last = 1 Then Temp = Last + 1 Else Temp = Last End If ' k was 6 ? k = 1 If lSrcLastRow >= k Then ' For j = 0 To lSrcLastRow - k ' Copy IOT DstWks.Cells(Temp + 1, "A").Value = IMTWks.Cells(5, "E").Value ' Copy IMT DstWks.Cells(Temp + 1, "B").Value = IMTWks.Cells(5, "F").Value 'Account Name DstWks.Cells(Temp + 1, "C").Value = IMTWks.Cells(5, "B").Value 'Account Segment DstWks.Cells(Temp + 1, "D").Value = IMTWks.Cells(5, "G").Value ' Lead Industry DstWks.Cells(Temp + 1, "E").Value = IMTWks.Cells(5, "D").Value MsgBox IMTWks.Cells(5, "E").Value ' Lead Sector DstWks.Cells(Temp + 1, "B").Value = IMTWks.Cells(5, "C").Value Temp = DstWks.Range("B65536").End(xlUp).Row ' Next ' Specify the range to place the data. If Last = 1 Then Last = Last + 1 End If Set CopyRng = SrcWks.Range("B6:N" & lSrcLastRow) CopyRng.Copy With DstWks.Cells(Last + 1, "G") .PasteSpecial xlPasteValues Application.CutCopyMode = False End With lLogLastRow = logWks.Range("A65536").End(xlUp).Row Dim p As Integer If i = 1 Then p = 2 Else p = 1 logWks.Cells(lLogLastRow + p, "A").Value = .FoundFiles(i) logWks.Cells(lLogLastRow + p, "B").Value = "Success" ElseIf lSrcLastRow = 5 Then lLogLastRow = logWks.Range("A65536").End(xlUp).Row If i = 1 Then p = 2 Else p = 1 logWks.Cells(lLogLastRow + p, "A").Value = .FoundFiles(i) logWks.Cells(lLogLastRow + p, "B").Value = "Success" End If ' Now we will close the open file and clean SrcWkb.Close savechanges:=False fileloop: Next ThisWorkbook.Save End ErrSub: MsgBox "Error happened and logging the Account " + File + " : " + Err.Description lLogLastRow = logWks.Range("A65536").End(xlUp).Row If i = 1 Then p = 2 Else p = 1 logWks.Cells(lLogLastRow + p, "A").Value = File logWks.Cells(lLogLastRow + p, "B").Value = "Failed" SrcWkb.Close savechanges:=False Resume fileloop: End If End With End Sub