Sub Populate_Summary_L()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
Dim ws_count As Integer
Dim j As Integer
Dim k As Integer
Dim c As Range
Dim lRow As Long
Dim ws2 As Worksheet
Set ws2 = Sheets("Summary_L")
lRow = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
'clear the contents first from the summary sheet
ws2.Range("A4:AT" & lRow).ClearContents
' Set ws_count equal to the number of worksheets in the active workbook.
ws_count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For j = 1 To ws_count
If Sheets(j).Name <> "Summary_L" And _
Sheets(j).Name <> "Summary_B" And _
Sheets(j).Name <> "Today" And _
Sheets(j).Name <> "Lookup Table" And _
Sheets(j).Name <> "Index" Then
Dim lastRow As Integer
lastRow = Sheets(j).Range("A" & Rows.Count).End(xlUp).Row
For i = 10 To lastRow Step 11
'v
Sheets(j).Range("B7").Copy
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "S").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "AK").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "BC").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
'v code
Sheets(j).Range("B8").Copy
ws2.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "T").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "AL").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "BD").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
'r type
Sheets(j).Cells(i, 1).Copy
ws2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "U").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "AM").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "BE").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
'start the copy based on criteria
If Sheets(j).Cells(i, 1).Offset(9, 1) = "L" Then
'G rating
'1FWL
'equal to or > 10 r criteria
If Sheets(j).Cells(i, 4) >= 10 Then
'equal to or less than req'd %
'If Sheets(j).Cells(i, 4).Offset(3).Value / 100 <= Cells(i, 4).Offset(2).Value Then
If Sheets(j).Cells(i, 4).Offset(2).Value <= 100 / (Sheets(j).Cells(i, 4).Offset(3).Value * 100) Then
'equal to venue
If Sheets(j).Cells(i, 1) = ws2.Cells(Rows.Count, "C").End(xlUp) Then
'copy l %
Sheets(j).Cells(i, 4).Offset(9).Copy
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 3).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 3).PasteSpecial xlPasteFormats
'copy av
Sheets(j).Cells(i, 4).Offset(3).Copy
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 4).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 4).PasteSpecial xlPasteFormats
End If
End If
End If
'2FWL
'equal to or > 10 r criteria
If Sheets(j).Cells(i, 5) >= 10 Then
'equal to or less than req'd %
If Sheets(j).Cells(i, 5).Offset(2).Value <= 100 / (Sheets(j).Cells(i, 5).Offset(3).Value * 100) Then
'equal to v
If Sheets(j).Cells(i, 1) = ws2.Cells(Rows.Count, "C").End(xlUp) Then
'copy l %
Sheets(j).Cells(i, 5).Offset(9).Copy
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 5).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 5).PasteSpecial xlPasteFormats
'copy Av
Sheets(j).Cells(i, 5).Offset(3).Copy
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 6).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 6).PasteSpecial xlPasteFormats
End If
End If
End If
'3FWL
'equal to or > 10 r criteria
If Sheets(j).Cells(i, 6) >= 10 Then
'equal to or less than req'd %
If Sheets(j).Cells(i, 6).Offset(2).Value <= 100 / (Sheets(j).Cells(i, 6).Offset(3).Value * 100) Then
'equal to v
If Sheets(j).Cells(i, 1) = ws2.Cells(Rows.Count, "C").End(xlUp) Then
'copy l %
Sheets(j).Cells(i, 6).Offset(9).Copy
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 7).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 7).PasteSpecial xlPasteFormats
'copy av
Sheets(j).Cells(i, 6).Offset(3).Copy
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 8).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 8).PasteSpecial xlPasteFormats
End If
End If
End If
'1FPL
'equal to or > 10 r criteria
If Sheets(j).Cells(i, 8) >= 10 Then
'equal to or less than req'd %
If Sheets(j).Cells(i, 8).Offset(2).Value <= 100 / (Sheets(j).Cells(i, 8).Offset(3).Value * 100) Then
'equal to v
If Sheets(j).Cells(i, 1) = ws2.Cells(Rows.Count, "C").End(xlUp) Then
'copy l %
Sheets(j).Cells(i, 8).Offset(9).Copy
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 10).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 10).PasteSpecial xlPasteFormats
'copy Av
Sheets(j).Cells(i, 8).Offset(3).Copy
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 11).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 11).PasteSpecial xlPasteFormats
End If
End If
End If
'2FPL
'equal to or > 10 r criteria
If Sheets(j).Cells(i, 9) >= 10 Then
'equal to or less than %
If Sheets(j).Cells(i, 9).Offset(2).Value <= 100 / (Sheets(j).Cells(i, 9).Offset(3).Value * 100) Then
'equal to v
If Sheets(j).Cells(i, 1) = ws2.Cells(Rows.Count, "C").End(xlUp) Then
'copy l %
Sheets(j).Cells(i, 9).Offset(9).Copy
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 12).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 12).PasteSpecial xlPasteFormats
'copy Av
Sheets(j).Cells(i, 9).Offset(3).Copy
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 13).PasteSpecial xlPasteValues
ws2.Cells(Rows.Count, "A").End(xlUp).Offset(0, 13).PasteSpecial xlPasteFormats
End If
End If
End If
End If
Next i
End If
Next j
End Sub
Bookmarks