vba to delete dynamic number of rows if they exist

[Mr_Ragweed2]

Hello and thanks for reading. I have code that copies data and pastes to another worksheet on the next available row. I am trying to delete a dynamic number of rows from a worksheet if they exist. I can search for a value in column C and lets call that value "dekalb". If vendor name exists i need to delete that row and the row after it. The dynamic part is that if "dekalb" exists once, i need to delete 2 rows. If it exists twice then delete 3 rows, exists 4 times then delete 5 rows, etc. Then, once i have deleted the rows i need to shift the deleted rows up (same as right-click delete, shift cells up). There could be other vendor names on the sheet. Below is an example of what a sheet could look like:

in this example rows 2, 3, and 4 need deleted and then shift up so that Allegiant is the new row 2. Then my code would paste data on the next available row.
Below is the code i have that captures the data and pastes it here (erring on the side of giving too much info here rather than creating more questions). I need to put this "delete code" in this loop somehow so that the delete happens before the new paste happens.

Dim ThisFinal As Long
    Dim I As Integer
    Dim OSumWS As Worksheet
    Dim DekalbWS As Worksheet

' Need to look first to see if vendor already exists. if "yes" then delete based on location, if "no" then proceed as normal.

    Set OSumWS = Sheets("Order Summary")
    Set DekalbWS = Sheets("Dekalb Seed Order Form")
    
    ThisFinal = OSumWS.Cells(Rows.Count, 17).End(xlUp).Row 'new line
    
    For I = 19 To 31
        
        If DekalbWS.Cells(I, 3).Value <> "" Then
            With Application.Intersect(DekalbWS.Rows(I).EntireRow, DekalbWS.Range("C:U"))
                .UnMerge
                .Copy
            End With
    
            OSumWS.Cells(ThisFinal + 1, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            
            ThisFinal = OSumWS.Cells(Rows.Count, 2).End(xlUp).Row 'new line
            
        End If
    Next I
    OSumWS.UsedRange.Columns.AutoFit
    Sheets("Dekalb Seed Order Form").Activate
    '----------------------------------------------------------------------------------------
    'below this line needs relocate to next available row after all product rows have been copied - works
               
     Dim copyRange1 As Range
     Dim copyRange2 As Range
     Dim copyRange3 As Range
     Dim copyRange4 As Range
     
     Dim cel As Range
     Dim pasteRange1 As Range
     Dim pasteRange2 As Range
     Dim pasteRange3 As Range
     Dim pasteRange4 As Range
     
     Dim FinalColumn As Long
     
     Set copyRange1 = Sheets("Dekalb Seed Order Form").Range("T39")
     Set copyRange2 = Sheets("Dekalb Seed Order Form").Range("T47")
     Set copyRange3 = Sheets("Dekalb Seed Order Form").Range("T57")
     Set copyRange4 = Sheets("Dekalb Seed Order Form").Range("N61")
     
     Set pasteRange1 = Sheets("Order Summary").Cells(ThisFinal + 1, 1)
     Set pasteRange2 = Sheets("Order Summary").Cells(ThisFinal + 1, 1)
     Set pasteRange3 = Sheets("Order Summary").Cells(ThisFinal + 1, 1)
     Set pasteRange4 = Sheets("Order Summary").Cells(ThisFinal + 1, 1)
 
     For Each cel In copyRange1
       cel.Copy
        FinalColumn = Sheets("Order Summary").Cells(1, Columns.Count).End(xlToLeft).Offset(1, -6).Column
        pasteRange1.Cells(1, FinalColumn).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     Next
     
     For Each cel In copyRange2
       cel.Copy
        FinalColumn = Sheets("Order Summary").Cells(1, Columns.Count).End(xlToLeft).Offset(1, -5).Column
        pasteRange2.Cells(1, FinalColumn).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Next
      
      For Each cel In copyRange3
       cel.Copy
        FinalColumn = Sheets("Order Summary").Cells(1, Columns.Count).End(xlToLeft).Offset(1, -4).Column
        pasteRange3.Cells(1, FinalColumn).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Next
      
       For Each cel In copyRange4
       cel.Copy
        FinalColumn = Sheets("Order Summary").Cells(1, Columns.Count).End(xlToLeft).Offset(1, -3).Column
        pasteRange4.Cells(1, FinalColumn).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Next
      
        Application.CutCopyMode = False
    
    End If

Apologies if this post looks familiar. I was originally trying to do an overwrite but ran into issues. This is a different approach altogether so i thought it was a different topic. This method will be much cleaner.
Thanks in advance.