macro help with deleting a cell range of all worksheets except 1

[cspeid03]

hello, i have this macro which copies data from one worksheet and then paste specific cells on a specific worksheet. problem is that when the macro is used again it doesnt replace the existing data on the others worksheets, therefore i end up with replicated data. i need my macro to delete all rows below row 9 and then paste the data, to avoid having repeated data.

this is my actual macro. Thanks in advance.


Sub Spread()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("All Orders").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("Argelia Internacional").Cells(Rows.Count, "A").End(xlUp).Row
lr3 = Sheets("Nova Zona Libre").Cells(Rows.Count, "A").End(xlUp).Row
lr4 = Sheets("Mercantil Zona Libre").Cells(Rows.Count, "A").End(xlUp).Row
lr5 = Sheets("Amazon Zona Libre").Cells(Rows.Count, "A").End(xlUp).Row
lr6 = Sheets("Casa Real Internacional").Cells(Rows.Count, "A").End(xlUp).Row
lr7 = Sheets("Issa Internacional").Cells(Rows.Count, "A").End(xlUp).Row
lr8 = Sheets("Silver Crown Internacional").Cells(Rows.Count, "A").End(xlUp).Row
lr9 = Sheets("Skala Zona Libre").Cells(Rows.Count, "A").End(xlUp).Row
lr10 = Sheets("Unico Internacional").Cells(Rows.Count, "A").End(xlUp).Row
lr10 = Sheets("Importadora Universal").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 11 Step -1
If Range("D" & r).Value = "Argelia Internacional" Then
Rows(r).Copy Destination:=Sheets("Argelia Internacional").Range("A" & lr2 + 1)
lr2 = Sheets("Argelia Internacional").Cells(Rows.Count, "A").End(xlUp).Row
End If
If Range("D" & r).Value = "Nova Zona Libre" Then
Rows(r).Copy Destination:=Sheets("Nova Zona Libre").Range("A" & lr3 + 1)
lr3 = Sheets("Nova Zona Libre").Cells(Rows.Count, "A").End(xlUp).Row
End If
If Range("D" & r).Value = "Mercantil Zona Libre" Then
Rows(r).Copy Destination:=Sheets("Mercantil Zona Libre").Range("A" & lr4 + 1)
lr4 = Sheets("Mercantil Zona Libre").Cells(Rows.Count, "A").End(xlUp).Row
End If
If Range("D" & r).Value = "Amazon Zona Libre" Then
Rows(r).Copy Destination:=Sheets("Amazon Zona Libre").Range("A" & lr5 + 1)
lr5 = Sheets("Amazon Zona Libre").Cells(Rows.Count, "A").End(xlUp).Row
End If
If Range("D" & r).Value = "Casa Real Internacional" Then
Rows(r).Copy Destination:=Sheets("Casa Real Internacional").Range("A" & lr6 + 1)
lr6 = Sheets("Casa Real Internacional").Cells(Rows.Count, "A").End(xlUp).Row
End If
If Range("D" & r).Value = "Issa Internacional" Then
Rows(r).Copy Destination:=Sheets("Issa Internacional").Range("A" & lr7 + 1)
lr7 = Sheets("Issa Internacional").Cells(Rows.Count, "A").End(xlUp).Row
End If
If Range("D" & r).Value = "Silver Crown Internacional" Then
Rows(r).Copy Destination:=Sheets("Silver Crown Internacional").Range("A" & lr8 + 1)
lr8 = Sheets("Silver Crown Internacional").Cells(Rows.Count, "A").End(xlUp).Row
End If
If Range("D" & r).Value = "Skala Zona Libre" Then
Rows(r).Copy Destination:=Sheets("Skala Zona Libre").Range("A" & lr9 + 1)
lr9 = Sheets("Skala Zona Libre").Cells(Rows.Count, "A").End(xlUp).Row
End If
If Range("D" & r).Value = "Unico Internacional" Then
Rows(r).Copy Destination:=Sheets("Unico Internacional").Range("A" & lr10 + 1)
lr10 = Sheets("Unico Internacional").Cells(Rows.Count, "A").End(xlUp).Row
End If
If Range("D" & r).Value = "Importadora Universal" Then
Rows(r).Copy Destination:=Sheets("Importadora Universal").Range("A" & lr11 + 1)
lr11 = Sheets("Importadora Universal").Cells(Rows.Count, "A").End(xlUp).Row
End If
Range("A1").Select
Next r
End Sub

 

[onlyadrafter]

Hello,

as per your heading, this will clear rows 9 onwards in every sheet (tab) except the first one (leftmost)

    For MY_SHEETS = 2 To ActiveWorkbook.Sheets.Count
        MY_LAST_ROW = Sheets(MY_SHEETS).UsedRange.Rows.Count
        Sheets(MY_SHEETS).Rows(9 & ":" & MY_LAST_ROW).ClearContents
    Next MY_SHEETS

 

[onlyadrafter]

Hello,

have re-written your macro

Sub NEW_SPREAD()
For MY_SHEETS = 2 To ActiveWorkbook.Sheets.Count
        MY_LAST_ROW = Sheets(MY_SHEETS).UsedRange.Rows.Count
        Sheets(MY_SHEETS).Rows(9 & ":" & MY_LAST_ROW).ClearContents
    Next MY_SHEETS
    With Sheets("All Orders")
        For MY_ROWS = 1 To .UsedRange.Rows.Count
            .Rows(MY_ROWS).Copy
            MY_SHEET = Sheets("All Orders").Range("D" & MY_ROWS).Value
            MY_LAST_ROW = Sheets(MY_SHEET).UsedRange.Rows.Count
            Sheets(MY_SHEET).Range("A" & MY_LAST_ROW + 1).PasteSpecial (xlValues)
        Next MY_ROWS
    End With
End Sub

this assumes that each sheet (tab) exists for the value in All Orders sheet.