Deleting multiple rows of data

I've been trying for some time but have not been able to get the right code to do what I need. I have a data file with multiple rows of data for multiple parts. This file gets to me as a csv. file. (see attatchment) I had something similar that I found here and was able to tweek to fit my needs, but it was for a sheet that only contained data for a single file on the worksheet (part of code below). The macro I need know has to work on a sheet with multiple parts (see attatchment for example of worksheet).

Sub ImpactDataProcessing_x10()
    Dim FileName
    Dim Title As String
    Dim i As Integer
    Dim x As Integer
    Dim lRow As Long, lLastRow As Long, lCnt As Long
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

Set newbook = Workbooks.Add(xlWBATWorksheet) 'create new workbook with single sheet chart
    With newbook
        .SaveAs FileName:="TestResults.xls"
    End With
        
'   set sheet name
        With ActiveSheet
            .Name = "SummaryData"
        End With

'   call subprogram to format sheet
        Call SummaryData

Set wkbAll = ActiveWorkbook 'set object workbook needed to compile data

'   Set the dialog box caption
    Title = "Select File(s) to Import"

'   Select CSV files
    FileName = Application.GetOpenFilename _
        ("Comma Separated Files (*.csv), *.csv", Title:=Title, MultiSelect:=True)

'   Exit if dialog box canceled
    If Not IsArray(FileName) Then
        MsgBox "No file was selected."
        Exit Sub
    End If
    
'   Loop through selected files and add to Results workbook
    For i = LBound(FileName) To UBound(FileName)
        Set wkbTemp = Workbooks.Open(FileName:=FileName(i))
'   store the workbook name in variable "temp"
        temp = ActiveWorkbook.Name
'   Moves active sheet to named workbook
        ActiveSheet.Move after:=Workbooks("TestResults.xls").Sheets(i)
        
'   Keep every 10th row of data
    
    Set wsSht = ActiveSheet

    lLastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    lCnt = 10

    For lRow = lLastRow To 10 Step -1
        If lCnt < 10 Then
            ActiveSheet.Range("A" & lRow).EntireRow.Delete
            lCnt = lCnt + 1
        Else
            lCnt = 1
        End If

    Next lRow
        
ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Hello Leal72,

Can you give an example of the data you want to keep and what you deleted? Will the worksheet data be stored in separate files?

Sincerely,
Leith Ross

I've attatched a workbook that has the file the way I receive it and the next sheet has it reduced.

Hello Leal72,

Thanks for taking the time to do that. I downloaded your file, and it is clear what you want to do. I'll work on this and post back.

Sincerely,
Leith Ross

Hello Leith Ross

Thanks for taking the time to look at this. Was wondering if you were able to come up with anything.

thanks

Hi,
This procedure will output the result into Sheets("AFTER") and you can change the names to fit your needs. I don't think it's the most efficient way to do it, but it should get the job done!

Public Sub TEST()
Dim lR
Dim SrcWS
Dim DstWS
Dim i
Dim j
Set SrcWS = Sheets("Before")
Set DstWS = Sheets("After")
DstWS.Cells.ClearContents
SrcWS.Activate
lR = SrcWS.Cells(SrcWS.Rows.Count, 1).End(xlUp).Row
j = 0

For i = 1 To lR
    If IsNumeric(Cells(i, 1).Value) Then
        If ((Cells(i, 1).Value Mod 10) = 0) Or Cells(i, 1).Value = 1 Then
            j = j + 1
            DstWS.Rows(j).Value = Rows(i).Value
        End If
    Else
        j = j + 1
        DstWS.Rows(j).Value = Rows(i).Value
    End If
    
Next i
End Sub

Good Luck!
Tony