Hi ExcelFox- yes all of the files are on a Sharepoint. What i have to this point- only consolidates the files from the First Dept, as the are split by column A on Unique IDs.
Code:
Sub mainConsolidation()
With Excel.Application
.ScreenUpdating = False
.Calculation = Excel.xlCalculationManual
.EnableEvents = False
End With
Dim a As Integer
Workbooks("CONSOLIDATE MASTER.xlsm").Worksheets("Sheet1").Range("A2:JP10000").ClearContents '
Call File2
Call File3
all Blank
With Excel.Application
.ScreenUpdating = True
.Calculation = Excel.xlAutomatic
.EnableEvents = True
End With
End Sub
Sub blank()
Dim mr As Range
Dim ict As Long
Set mr = ActiveSheet.UsedRange
For ict = mr.Rows.Count To 1 Step -1
If Application.CountA(Rows(ict).EntireRow) = 0 Then
Rows(ict).Delete
End If
Next ict
End Sub
Sub File2()
Dim arange As String
Dim a As Integer
Dim cell As Object
Dim wb As Workbook
Application.DisplayStatusBar = True
Set wb = Workbooks.Open("Sharepoint /File2.xlsm")
Workbooks("File2.xlsm").Worksheets("Sheet1").Activate
ActiveSheet.Cells.EntireColumn.Hidden = False
ActiveSheet.Cells.EntireRow.Hidden = False
With ActiveSheet
If .AutoFilterMode Then
If .FilterMode Then
.ShowAllData
End If
End If
End With
a = Workbooks("CONSOLIDATE MASTER.xlsm").Worksheets("Sheet1").UsedRange.Rows.Count
Dim rc1 As Integer
rc1 = Workbooks("File2.xlsm").Worksheets("Sheet1").Range("A10000").End(xlUp).Row ' ptn column is A
Dim rc2 As Integer
rc2 = Workbooks("CONSOLIDATE MASTER.xlsm").Worksheets("Sheet1").Range("A:A").SpecialCells(xlLastCell).Row - 1
arange = "A2:JP" & rc1
Workbooks("File2.xlsm").Worksheets("Sheet1").Range(arange).Copy
Workbooks("CONSOLIDATE MASTER.xlsm").Worksheets("Sheet1").Range(arange).PasteSpecial Paste:=xlPasteValues
Workbooks("File2.xlsm").Close savechanges:=False
End Sub
Bookmarks