How can I streamline my VBA code to run faster?

Question

Relatively new VBA coder, and I have an excel macro that is running slow.

The following code that is built to take non-blank lines of data from one sheet (for example, Sheet12 "CLIENT 1") and move them to other sheets based on a cell value. The data can be sent to one of 5 sheets, and there are 4 sheets of data that need to be sorted.

The code works at the moment, but it runs REALLY slow - especially when there's a lot of data. Is there a better way to write this code to speed up the run time?

Private Sub REFRESH_DATA()

Sheet3.Range("A3:Z2000").ClearContents            'Clear GREEN_Data
Sheet5.Range("A3:Z2000").ClearContents            'Clear BLUE_Data
Sheet7.Range("A3:Z2000").ClearContents            'Clear PURPLE_Data
Sheet9.Range("A3:Z2000").ClearContents            'Clear YELLOW_Data
Sheet11.Range("A3:Z2000").ClearContents           'Clear ORANGE_Data

Application.ScreenUpdating = False                'Stop screen from flashing

Dim s As Long
Dim AA As Long
Dim AB As Long
Dim AC As Long
Dim AD As Long
Dim A1 As Long
Dim A2 As Long
Dim A3 As Long
Dim A4 As Long
Dim A5 As Long

AA = Sheet12.Range("A" & Sheet12.Rows.Count).End(xlUp).Row  'Project List - Client 1
AB = Sheet13.Range("A" & Sheet13.Rows.Count).End(xlUp).Row  'Project List - Client 2
AC = Sheet14.Range("A" & Sheet14.Rows.Count).End(xlUp).Row  'Project List - Client 3
AD = Sheet15.Range("A" & Sheet15.Rows.Count).End(xlUp).Row  'Project List - Client 4

A1 = Sheet3.Range("A" & Sheet3.Rows.Count).End(xlUp).Row     'GREEN_Data
A2 = Sheet5.Range("A" & Sheet5.Rows.Count).End(xlUp).Row     'BLUE_Data
A3 = Sheet7.Range("A" & Sheet7.Rows.Count).End(xlUp).Row     'PURPLE_Data
A4 = Sheet9.Range("A" & Sheet9.Rows.Count).End(xlUp).Row     'YELLOW_Data
A5 = Sheet11.Range("A" & Sheet11.Rows.Count).End(xlUp).Row   'ORANGE_Data

For s = 5 To AA     'Project List - Client 1
    If Sheet12.Cells(s, 28).Value = True Then
        Sheet12.Range("A" & s).Resize(ColumnSize:=27).Copy
        A1 = A1 + 1
        Sheet3.Range("A" & A1).PasteSpecial Paste:=xlPasteValues     'GREEN_Data
    End If
    If Sheet12.Cells(s, 29).Value = True Then
        Sheet12.Range("A" & s).Resize(ColumnSize:=27).Copy
        A2 = A2 + 1
        Sheet5.Range("A" & A2).PasteSpecial Paste:=xlPasteValues     'BLUE_Data
    End If
    If Sheet12.Cells(s, 30).Value = True Then
        Sheet12.Range("A" & s).Resize(ColumnSize:=27).Copy
        A3 = A3 + 1
        Sheet7.Range("A" & A3).PasteSpecial Paste:=xlPasteValues     'PURPLE_Data
    End If
    If Sheet12.Cells(s, 31).Value = True Then
        Sheet12.Range("A" & s).Resize(ColumnSize:=27).Copy
        A4 = A4 + 1
        Sheet9.Range("A" & A4).PasteSpecial Paste:=xlPasteValues     'YELLOW_Data
    End If
    If Sheet12.Cells(s, 32).Value = True Then
        Sheet12.Range("A" & s).Resize(ColumnSize:=27).Copy
        A5 = A5 + 1
        Sheet11.Range("A" & A5).PasteSpecial Paste:=xlPasteValues    'ORANGE_Data
    End If
Next s
For s = 5 To AB     'Project List - Client 2
    If Sheet13.Cells(s, 28).Value = True Then
        Sheet13.Range("A" & s).Resize(ColumnSize:=27).Copy
        A1 = A1 + 1
        Sheet3.Range("A" & A1).PasteSpecial Paste:=xlPasteValues     'GREEN_Data
    End If
    If Sheet13.Cells(s, 29).Value = True Then
        Sheet13.Range("A" & s).Resize(ColumnSize:=27).Copy
        A2 = A2 + 1
        Sheet5.Range("A" & A2).PasteSpecial Paste:=xlPasteValues     'BLUE_Data
    End If
    If Sheet13.Cells(s, 30).Value = True Then
        Sheet13.Range("A" & s).Resize(ColumnSize:=27).Copy
        A3 = A3 + 1
        Sheet7.Range("A" & A3).PasteSpecial Paste:=xlPasteValues     'PURPLE_Data
    End If
    If Sheet13.Cells(s, 31).Value = True Then
        Sheet13.Range("A" & s).Resize(ColumnSize:=27).Copy
        A4 = A4 + 1
        Sheet9.Range("A" & A4).PasteSpecial Paste:=xlPasteValues     'YELLOW_Data
    End If
    If Sheet13.Cells(s, 32).Value = True Then
        Sheet13.Range("A" & s).Resize(ColumnSize:=27).Copy
        A5 = A5 + 1
        Sheet11.Range("A" & A5).PasteSpecial Paste:=xlPasteValues    'ORANGE_Data
    End If
Next s
For s = 5 To AC     'Project List - Client 3
    If Sheet14.Cells(s, 28).Value = True Then
        Sheet14.Range("A" & s).Resize(ColumnSize:=27).Copy
        A1 = A1 + 1
        Sheet3.Range("A" & A1).PasteSpecial Paste:=xlPasteValues     'GREEN_Data
    End If
    If Sheet14.Cells(s, 29).Value = True Then
        Sheet14.Range("A" & s).Resize(ColumnSize:=27).Copy
        A2 = A2 + 1
        Sheet5.Range("A" & A2).PasteSpecial Paste:=xlPasteValues     'BLUE_Data
    End If
    If Sheet14.Cells(s, 30).Value = True Then
        Sheet14.Range("A" & s).Resize(ColumnSize:=27).Copy
        A3 = A3 + 1
        Sheet7.Range("A" & A3).PasteSpecial Paste:=xlPasteValues     'PURPLE_Data
    End If
    If Sheet14.Cells(s, 31).Value = True Then
        Sheet14.Range("A" & s).Resize(ColumnSize:=27).Copy
        A4 = A4 + 1
        Sheet9.Range("A" & A4).PasteSpecial Paste:=xlPasteValues     'YELLOW_Data
    End If
    If Sheet14.Cells(s, 32).Value = True Then
        Sheet14.Range("A" & s).Resize(ColumnSize:=27).Copy
        A5 = A5 + 1
        Sheet11.Range("A" & A5).PasteSpecial Paste:=xlPasteValues    'ORANGE_Data
    End If
Next s
For s = 5 To AD     'Project List - Client 4
    If Sheet15.Cells(s, 28).Value = True Then
        Sheet15.Range("A" & s).Resize(ColumnSize:=27).Copy
        A1 = A1 + 1
        Sheet3.Range("A" & A1).PasteSpecial Paste:=xlPasteValues     'GREEN_Data
    End If
    If Sheet15.Cells(s, 29).Value = True Then
        Sheet15.Range("A" & s).Resize(ColumnSize:=27).Copy
        A2 = A2 + 1
        Sheet5.Range("A" & A2).PasteSpecial Paste:=xlPasteValues     'BLUE_Data
    End If
    If Sheet15.Cells(s, 30).Value = True Then
        Sheet15.Range("A" & s).Resize(ColumnSize:=27).Copy
        A3 = A3 + 1
        Sheet7.Range("A" & A3).PasteSpecial Paste:=xlPasteValues     'PURPLE_Data
    End If
    If Sheet15.Cells(s, 31).Value = True Then
        Sheet15.Range("A" & s).Resize(ColumnSize:=27).Copy
        A4 = A4 + 1
        Sheet9.Range("A" & A4).PasteSpecial Paste:=xlPasteValues     'YELLOW_Data
    End If
    If Sheet15.Cells(s, 32).Value = True Then
        Sheet15.Range("A" & s).Resize(ColumnSize:=27).Copy
        A5 = A5 + 1
        Sheet11.Range("A" & A5).PasteSpecial Paste:=xlPasteValues    'ORANGE_Data
    End If
Next s

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Thanks in advance for your help!

Answer 1

Should be faster:

Private Sub REFRESH_DATA()

    Const COPY_COLS As Long = 27
    Dim ws, rw As Long, arrDestSheets, arrDestRows, n As Long
    
    Application.ScreenUpdating = False                'Stop screen from flashing
    
    'sheets to copy to:    green  blue    purple  yellow  orange
    arrDestSheets = Array(Sheet3, Sheet5, Sheet7, Sheet9, Sheet11)
    arrDestRows = Array(3, 3, 3, 3, 3) 'destination rows in each sheet
    
    'clear all destination sheets
    For Each ws In arrDestSheets
        ws.Range("A3:Z2000").ClearContents
    Next ws
    
    For Each ws In Array(Sheet12, Sheet13, Sheet14, Sheet15)
        For rw = 5 To ws.Cells(Rows.Count, 1).End(xlUp).Row
            For n = 0 To 4
                If ws.Cells(rw, 28 + n) = True Then
                    arrDestSheets(n).Cells(arrDestRows(n), 1).Resize(1, COPY_COLS).Value = _
                        ws.Cells(rw, 1).Resize(1, COPY_COLS).Value
                    arrDestRows(n) = arrDestRows(n) + 1
                    'Exit For  'uncomment if only one match per row
                End If
            Next n
        Next rw
    Next ws
    
    Application.ScreenUpdating = True
End Sub

Answer 2

First thing to do: drop the "Copy-Paste" constructions, as you can see here:

Your code:

        Sheet12.Range("A" & s).Resize(ColumnSize:=27).Copy
        A1 = A1 + 1
        Sheet3.Range("A" & A1).PasteSpecial Paste:=xlPasteValues     'GREEN_Data

My proposal:

        Sheet12.Range("A" & s).Resize(ColumnSize:=27)
        A1 = A1 + 1
        Sheet3.Range("A" & A1).Value = Sheet12.Range("A" & s).Value    'GREEN_Data

Like this you avoid passing over the clipboard, which is, in my humble opinion, a huge performance-dropper.