Hi

I have the following code that cycles through my workbook (currently has about 150 sheets so is very large) and copies certain values to my main sheet. It is extremely slow.

I am wondering if there is a better and faster way to do this? I also update my workbook frequently so when I add a sheet, I need to run the code all over again, which is very frustrating. I am looking for a way to also just update based on the sheet I have just added?

This is just one part of the code - it is repeated three more times however I cannot post here as it is too long!

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