Solved: how can i add "count" and "Sum" in existing code

[rrosa1]

hi
i need to modified the following code to automation of macro as
count the cell which have value in column C and put the value in C1
and
sum the cell value in column H and put the value in H1
also in code it delete the row >=48 but not <= 0 is there anyway i can change the code to do delete the row <=0 and >=48
any help will be appreciated.
thanks for looking my problem.
ps here is my sample data wb

Option Explicit
Sub AppendData()
Dim ws As Worksheet
Dim i As Long
Dim ws1 As Worksheet

'Delete the sheet "Names" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Names").Delete
On Error GoTo 0
Application.DisplayAlerts = True


Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Names"
For Each ws In ThisWorkbook.Worksheets
With ws
If .Name <> "Names" Then
.Range("B1:T1").Copy Destination:=Sheets("Names").Range("A" & Rows.Count).End(xlUp).Offset(2)
.Range("A6:T59").Copy Destination:=Sheets("Names").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End With
Next ws


Set ws1 = ThisWorkbook.Worksheets("Names")
With ws1
For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 8 Step -1
If .Cells(i, 8).Value >= 48 Then
.Rows(i).Delete

End If
Next i

End With

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

[Bob Phillips]

Option Explicit
Sub AppendData()
Dim ws As Worksheet
Dim LastRow As Long
Dim i As Long
Dim ws1 As Worksheet

'Delete the sheet "Names" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Names").Delete
On Error GoTo 0
Application.DisplayAlerts = True


Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Names"
For Each ws In ThisWorkbook.Worksheets
With ws
If .Name <> "Names" Then
.Range("B1:T1").Copy Destination:=Sheets("Names").Range("A" & Rows.Count).End(xlUp).Offset(2)
.Range("A6:T59").Copy Destination:=Sheets("Names").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End With
Next ws

Set ws1 = ThisWorkbook.Worksheets("Names")
With ws1
For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 8 Step -1
If .Cells(i, 8).Value <= 0 And .Cells(i, 8).Value >= 48 Then
.Rows(i).Delete
End If
Next i

LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
.Range("C1").Formula = "=COUNTA(C3:C" & LastRow & ")"
LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Range("H1").Formula = "=SUM(H3:H" & LastRow & ")"
End With

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

[rrosa1]

thanks XLd
but the code seems not delete the Row <=0 and >=48
thanks again for help

[Bob Phillips]

Oops, the AND should be an OR



Option Explicit
Sub AppendData()
Dim ws As Worksheet
Dim LastRow As Long
Dim i As Long
Dim ws1 As Worksheet

'Delete the sheet "Names" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Names").Delete
On Error Goto 0
Application.DisplayAlerts = True


Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Names"
For Each ws In ThisWorkbook.Worksheets
With ws
If .Name <> "Names" Then
.Range("B1:T1").Copy Destination:=Sheets("Names").Range("A" & Rows.Count).End(xlUp).Offset(2)
.Range("A6:T59").Copy Destination:=Sheets("Names").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End With
Next ws

Set ws1 = ThisWorkbook.Worksheets("Names")
With ws1
For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 8 Step -1
If .Cells(i, 8).Value <= 0 Or .Cells(i, 8).Value >= 48 Then
.Rows(i).Delete
End If
Next i

LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
.Range("C1").Formula = "=COUNTA(C3:C" & LastRow & ")"
LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Range("H1").Formula = "=SUM(H3:H" & LastRow & ")"
End With

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

[rrosa1]

thanks Xld
u the man