I can't quite get this working???
Code:
Option Explicit
Sub GetFiles()
Dim strEst1 As String
Dim strEst2 As String
strEst1 = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*), *.xls*", Title:="Select the FIRST estimate")
strEst2 = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*), *.xls*", Title:="Select the SECOND estimate")
If strEst1 <> "False" And strEst2 <> "False" Then
Workbooks.Open strEst1, False 'This is workbooks.count - 2
BreakAllLinks ActiveWorkbook
Workbooks.Open strEst2, False 'This is workbooks.count - 1
BreakAllLinks ActiveWorkbook
Workbooks.Add 'This is workbooks.count
Workbooks(Workbooks.Count - 2).Worksheets("ss bom").ListObjects(1).Unlist
Workbooks(Workbooks.Count - 2).Worksheets("ss bom").Range("a1").CurrentRegion.Copy
ActiveCell.PasteSpecial xlPasteColumnWidths
ActiveCell.PasteSpecial xlPasteValuesAndNumberFormats
Dim newHeadings As Integer
newHeadings = ActiveWorkbook.Worksheets(1).Range("a1").End(xlDown).Offset(1, 0).Row
Workbooks(Workbooks.Count - 1).Worksheets("ss bom").ListObjects(1).Unlist
Workbooks(Workbooks.Count - 1).Worksheets("ss bom").Range("a1").CurrentRegion.Copy
ActiveCell.End(xlDown).Offset(1, 0).Select
ActiveCell.PasteSpecial xlPasteColumnWidths
ActiveCell.PasteSpecial xlPasteValuesAndNumberFormats
Rows(newHeadings).Delete
Workbooks(Workbooks.Count - 2).Close savechanges:=False
Workbooks(Workbooks.Count - 1).Close savechanges:=False
Range("a1").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("a1").CurrentRegion, , xlYes).Name = _
"CombinedEstimates"
End If
End Sub
Last edited by a moderator: