Autofilter loop + copy paste?

Hey all,

I managed to write a working piece of code (see post 2), but it's quite amateurish.
Does anyone feel like reviewing my code or make it a lot more simple?

What the marcro does (see attachment):

1) Write down the name of the company (test value: A, B, C, D, E or F)
2) It sets 4 different filters and copy pastes each filtered result, but only if the filtered result > 0.
3) The position of the copy-pasted part is dynamic.

If the first filter has a result, the result should be copied to last row +2 (below the text) and if the second filter has a result, the result should be copied to a new lastrow +3 (thus below the first result).

If the first filter has no result it should not be copied and if the second filter has a result it should be copied to last row +2 (below the text) and the third filter should be copied to a new last row + 3 ( thus below the second result).

The different values show you what I mean.

Small bump as I simplified the code a little bit.

Does anyone have more ideas on how to shorten the code and still have the same result?
Is there some loop possible for the KPI1-2-3 part? It's exacly the same except for the .autofilter field:=19, Criteria1:= part

Thanks

Sub copy_data()

' =======================================
' Here we create the data for varCompany
' =======================================

Dim varSourceLR As Long

' Set definitions
' ---------------

Set wsLaunch = Sheets("Sheet1")
Set wsSource = Sheets("Sheet2")
Set wsSummary = Sheets("Sheet3")
Set wb = ThisWorkbook

varcompany = wsLaunch.Range("B7").Value

Application.ScreenUpdating = False

' Delete previous data
' --------------------

wsSummary.Cells.Clear

On Error Resume Next
wsSource.ShowAllData

' Create a message in wsSummary
' -------------------------------------

    With wsSummary
        .Range("A1").Value = "Dear supplier"
        .Range("A3").Value = "At SNCB we want to put a stronger focus on communication with our suppliers and on on-time deliveries."
        .Range("A4").Value = "Therefore we ask you to have a close look at the list below and we’d like to receive your feedback" & _
                             " (which you can fill out in the table below) via mail (as a reply on this mail) within the next 5 working days."
        .Range("A5").Value = "(If you’re already using the SupplyOn portal, please do fill out the updated delivery dates directly on the portal.)"
    End With

' Copy the data from the wsSource to the wsSummary
' ------------------------------------------------

varSourceLR = wsSource.Cells(Rows.Count, 1).End(xlUp).Row

' KPI4 and KPI5
' -------------

    With wsSource.Rows(1)
            .AutoFilter field:=1, Criteria1:=varcompany
            .AutoFilter field:=19, Criteria1:="KPI4", Operator:=xlOr, Criteria2:="KPI5"
            .AutoFilter field:=17, Criteria1:=""
    End With
    
    If wsSource.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 > 0 Then
        With wsSummary
            .Cells(.Rows.Count, "A").End(xlUp).Offset(2, 0).Value = "Following order lines are urgently needed at SNCB:"
            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 0).Characters(Start:=27, Length:=8).Font.ColorIndex = 3
            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 0).Characters(Start:=27, Length:=8).Font.Bold = True
        End With
        With wsSource
            .Range("A1:R" & varSourceLR).SpecialCells(xlCellTypeVisible).Copy Destination:=wsSummary.Cells(.Rows.Count, "A").End(xlUp).Offset(2, 0)
        End With
    End If

'' KPI3
'' ----

    With wsSource.Rows(1)
            .AutoFilter field:=1, Criteria1:=varcompany
            .AutoFilter field:=19, Criteria1:="KPI3"
            .AutoFilter field:=17, Criteria1:=""
    End With

    If wsSource.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 > 0 Then
        If Not IsEmpty(wsSummary.Cells(7, 1).Value) Then
            wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(4, 0).Value = "Following order lines were requested or confirmed for delivery before today:"
            wsSource.Range("A1:R" & varSourceLR).SpecialCells(xlCellTypeVisible).Copy Destination:=wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
        Else
            wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(4, 0).Value = "Following order lines were requested or confirmed for delivery before today:"
            wsSource.Range("A1:R" & varSourceLR).SpecialCells(xlCellTypeVisible).Copy Destination:=wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
        End If
    End If

' KPI2
' ----

    With wsSource.Rows(1)
            .AutoFilter field:=1, Criteria1:=varcompany
            .AutoFilter field:=19, Criteria1:="KPI2"
            .AutoFilter field:=17, Criteria1:=""
    End With

    If wsSource.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 > 0 Then
        If Not IsEmpty(wsSummary.Cells(7, 1).Value) Then
            wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(4, 0).Value = "Following order lines have a confirmed delivery date that is later than the delivery date requested by SNCB:"
            wsSource.Range("A1:R" & varSourceLR).SpecialCells(xlCellTypeVisible).Copy Destination:=wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
        Else
            wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(4, 0).Value = "Following order lines have a confirmed delivery date that is later than the delivery date requested by SNCB:"
            wsSource.Range("A1:R" & varSourceLR).SpecialCells(xlCellTypeVisible).Copy Destination:=wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
        End If
    End If


' KPI1
' ----

    With wsSource.Rows(1)
            .AutoFilter field:=1, Criteria1:=varcompany
            .AutoFilter field:=19, Criteria1:="KPI1"
            .AutoFilter field:=17, Criteria1:=""
    End With

    If wsSource.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 > 0 Then
        If Not IsEmpty(wsSummary.Cells(7, 1).Value) Then
            wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(4, 0).Value = "Following order lines have not been confirmed yet:"
            wsSource.Range("A1:R" & varSourceLR).SpecialCells(xlCellTypeVisible).Copy Destination:=wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
        Else
            wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(4, 0).Value = "Following order lines have not been confirmed yet:"
            wsSource.Range("A1:R" & varSourceLR).SpecialCells(xlCellTypeVisible).Copy Destination:=wsSummary.Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
        End If
    End If
       
' Format wsSummary
' ----------------

    With wsSummary
        .Columns("B").AutoFit
        .Columns("D:I").AutoFit
        .Columns("J").ColumnWidth = 40
        .Columns("N:O").AutoFit
        .Columns("R").AutoFit
    End With
    
' Active wsSummary
' ----------------

    Application.ScreenUpdating = True
    wsSummary.Activate

End Sub