Sub Copydata()
Application.ScreenUpdating = False
Dim lRow1 As Long, lRow2 As Long, lRow3 As Long
Dim odWS As Worksheet, faWS As Worksheet, srcWB As Workbook, ws As Worksheet, od As Range, fa As Range
Dim no As Range, desc As Range, rev As Range, SD As Range, RD As Range, Stat As Range, shArr As Variant, i As Long
Set odWS = ThisWorkbook.Sheets("OVERDUE")
Set faWS = ThisWorkbook.Sheets("FOR ACTION")
odWS.UsedRange.Offset(11).ClearContents
faWS.UsedRange.Offset(11).ClearContents
Const strPath As String = "C:\Users\User\Desktop\Report\" 'change the folder path to suit your needs
ChDir strPath
strExtension = Dir(strPath & "*.xlsx")
Do While strExtension <> ""
If strExtension = "MATERIAL.xlsx" Then
Set srcWB = Workbooks.Open(strPath & strExtension)
shArr = Array("CV", "ST", "AR", "EL", "ME")
With srcWB
For i = LBound(shArr) To UBound(shArr)
Set ws = Sheets(shArr(i))
If ws.AutoFilterMode Then ws.AutoFilterMode = False
lRow1 = odWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
lRow2 = faWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With ws
lRow3 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Set od = .Rows(11).Find("OVERDUE")
Set fa = .Rows(11).Find("FOR ACTION")
With .Rows(11)
Set no = .Find("Ref No")
Set desc = .Find("Desc")
Set rev = .Find("Rev")
Set SD = .Find("Sub Date")
Set RD = .Find("Rep Date")
Set Stat = .Find("Status")
End With
.Cells(11, 1).CurrentRegion.AutoFilter od.Column, "OVERDUE"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column)).EntireColumn).Copy odWS.Range("D" & lRow1)
.Range("A11").AutoFilter
.Cells(11, 1).CurrentRegion.AutoFilter fa.Column, "FOR ACTION"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column), .Columns(RD.Column), .Columns(Stat.Column)).EntireColumn).Copy faWS.Range("D" & lRow2)
.Range("A11").AutoFilter
End With
Next i
.Close savechanges:=False
End With
ElseIf strExtension = "DOCUMENT.xlsx" Then
Set srcWB = Workbooks.Open(strPath & strExtension)
shArr = Array("CV", "ST", "AR", "EL", "ME", "OTH", "REP")
With srcWB
For i = LBound(shArr) To UBound(shArr)
Set ws = Sheets(shArr(i))
If ws.AutoFilterMode Then ws.AutoFilterMode = False
lRow1 = odWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
lRow2 = faWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With ws
lRow3 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Set od = .Rows(11).Find("OVERDUE")
Set fa = .Rows(11).Find("FOR ACTION")
With .Rows(11)
Set no = .Find("Ref No")
Set desc = .Find("Desc")
Set rev = .Find("Rev")
Set SD = .Find("Sub Date")
Set RD = .Find("Rep Date")
Set Stat = .Find("Status")
End With
.Cells(11, 1).CurrentRegion.AutoFilter od.Column, "OVERDUE"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column)).EntireColumn).Copy odWS.Range("D" & lRow1)
.Range("A11").AutoFilter
.Cells(11, 1).CurrentRegion.AutoFilter fa.Column, "FOR ACTION"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column), .Columns(RD.Column), .Columns(Stat.Column)).EntireColumn).Copy faWS.Range("D" & lRow2)
.Range("A11").AutoFilter
End With
Next i
.Close savechanges:=False
End With
ElseIf strExtension = "SUBCON.xlsx" Then
Set srcWB = Workbooks.Open(strPath & strExtension)
shArr = Array("CV", "AR", "EL", "ME", "GE", "MEP")
With srcWB
For i = LBound(shArr) To UBound(shArr)
Set ws = Sheets(shArr(i))
If ws.AutoFilterMode Then ws.AutoFilterMode = False
lRow1 = odWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
lRow2 = faWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With ws
lRow3 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Set od = .Rows(11).Find("OVERDUE")
Set fa = .Rows(11).Find("FOR ACTION")
With .Rows(11)
Set no = .Find("Ref No")
Set desc = .Find("Desc")
Set rev = .Find("Rev")
Set SD = .Find("Sub Date")
Set RD = .Find("Rep Date")
Set Stat = .Find("Status")
End With
.Cells(11, 1).CurrentRegion.AutoFilter od.Column, "OVERDUE"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column)).EntireColumn).Copy odWS.Range("D" & lRow1)
.Range("A11").AutoFilter
.Cells(11, 1).CurrentRegion.AutoFilter fa.Column, "FOR ACTION"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column), .Columns(RD.Column), .Columns(Stat.Column)).EntireColumn).Copy faWS.Range("D" & lRow2)
.Range("A11").AutoFilter
End With
Next i
.Close savechanges:=False
End With
ElseIf strExtension = "METHOD.xlsx" Then
Set srcWB = Workbooks.Open(strPath & strExtension)
shArr = Array("CV", "AR", "EL", "ME", "SUM")
With srcWB
For i = LBound(shArr) To UBound(shArr)
Set ws = Sheets(shArr(i))
If ws.AutoFilterMode Then ws.AutoFilterMode = False
lRow1 = odWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
lRow2 = faWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With ws
lRow3 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Set od = .Rows(11).Find("OVERDUE")
Set fa = .Rows(11).Find("FOR ACTION")
With .Rows(11)
Set no = .Find("Ref No")
Set desc = .Find("Desc")
Set rev = .Find("Rev")
Set SD = .Find("Sub Date")
Set RD = .Find("Rep Date")
Set Stat = .Find("Status")
End With
.Cells(11, 1).CurrentRegion.AutoFilter od.Column, "OVERDUE"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column)).EntireColumn).Copy odWS.Range("D" & lRow1)
.Range("A11").AutoFilter
.Cells(11, 1).CurrentRegion.AutoFilter fa.Column, "FOR ACTION"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column), .Columns(RD.Column), .Columns(Stat.Column)).EntireColumn).Copy faWS.Range("D" & lRow2)
.Range("A11").AutoFilter
End With
Next i
.Close savechanges:=False
End With
ElseIf strExtension = "SHOP DWG.xlsx" Or strExtension = "AS-BUILT.xlsx" Then
Set srcWB = Workbooks.Open(strPath & strExtension)
With srcWB
Set ws = Sheets("TR")
If ws.AutoFilterMode Then ws.AutoFilterMode = False
lRow1 = odWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
lRow2 = faWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With ws
lRow3 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Set od = .Rows(11).Find("OVERDUE")
Set fa = .Rows(11).Find("FOR ACTION")
With .Rows(11)
Set no = .Find("Ref No")
Set desc = .Find("Desc")
Set rev = .Find("Rev")
Set SD = .Find("Sub Date")
Set RD = .Find("Rep Date")
Set Stat = .Find("Status")
End With
.Cells(11, 1).CurrentRegion.AutoFilter od.Column, "OVERDUE"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column)).EntireColumn).Copy odWS.Range("D" & lRow1)
.Range("A11").AutoFilter
.Cells(11, 1).CurrentRegion.AutoFilter fa.Column, "FOR ACTION"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column), .Columns(RD.Column), .Columns(Stat.Column)).EntireColumn).Copy faWS.Range("D" & lRow2)
.Range("A11").AutoFilter
End With
.Close savechanges:=False
End With
ElseIf strExtension = "INFORMATION.xlsx" Then
Set srcWB = Workbooks.Open(strPath & strExtension)
With srcWB
Set ws = Sheets("RI")
If ws.AutoFilterMode Then ws.AutoFilterMode = False
lRow1 = odWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
lRow2 = faWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With ws
lRow3 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Set od = .Rows(11).Find("OVERDUE")
Set fa = .Rows(11).Find("FOR ACTION")
With .Rows(11)
Set no = .Find("Ref No")
Set desc = .Find("Desc")
Set rev = .Find("Rev")
Set SD = .Find("Sub Date")
Set RD = .Find("Rep Date")
Set Stat = .Find("Status")
End With
.Cells(11, 1).CurrentRegion.AutoFilter od.Column, "OVERDUE"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column)).EntireColumn).Copy odWS.Range("D" & lRow1)
.Range("A11").AutoFilter
.Cells(11, 1).CurrentRegion.AutoFilter fa.Column, "FOR ACTION"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column), .Columns(RD.Column), .Columns(Stat.Column)).EntireColumn).Copy faWS.Range("D" & lRow2)
.Range("A11").AutoFilter
End With
.Close savechanges:=False
End With
ElseIf strExtension = "TESTING.xlsx" Then
Set srcWB = Workbooks.Open(strPath & strExtension)
shArr = Array("CV", "AR", "EL", "ME")
With srcWB
For i = LBound(shArr) To UBound(shArr)
Set ws = Sheets(shArr(i))
If ws.AutoFilterMode Then ws.AutoFilterMode = False
lRow1 = odWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
lRow2 = faWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With ws
lRow3 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Set od = .Rows(11).Find("OVERDUE")
Set fa = .Rows(11).Find("FOR ACTION")
With .Rows(11)
Set no = .Find("Ref No")
Set desc = .Find("Desc")
Set rev = .Find("Rev")
Set SD = .Find("Sub Date")
Set RD = .Find("Rep Date")
Set Stat = .Find("Status")
End With
.Cells(11, 1).CurrentRegion.AutoFilter od.Column, "OVERDUE"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column)).EntireColumn).Copy odWS.Range("D" & lRow1)
.Range("A11").AutoFilter
.Cells(11, 1).CurrentRegion.AutoFilter fa.Column, "FOR ACTION"
Intersect(.Range("B12:R" & lRow3).SpecialCells(xlCellTypeVisible), Union(.Columns(no.Column), .Columns(rev.Column), .Columns(desc.Column), .Columns(SD.Column), .Columns(RD.Column), .Columns(Stat.Column)).EntireColumn).Copy faWS.Range("D" & lRow2)
.Range("A11").AutoFilter
End With
Next i
.Close savechanges:=False
End With
End If
strExtension = Dir
Loop
Application.ScreenUpdating = True
End Sub