VBA copy match text one row above data from one sheet to summay sheet

[SAMHOTONY]

My workbook has summary sheet and many different sheets ( sheet name 1809.1810,1811 son one). each sheet has text `subtotal on column D , but different sheet row for subtotal is different. I want to copy data from one row above from subtotal row to column P to summary sheet one by one for sheet. example. copy range should be (D5:P & one row above subtotal`) . my VBA below copy all data from different sheet, dont know to how to code for this , please help me.

Public Sub CopyToSummary()
Dim ws  As Worksheet, _
    LR1 As Long, _
    LR2 As Long
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets


If ws.Name <> "Summary" And (Left(ws.Name, 1) = "1" Or Left(ws.Name, 1) = "4" Or Left(ws.Name, 1) = "6" Or Left(ws.Name, 1) = "7") Then


           
        LR1 = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row + 1
        
        'need help to copy one row above "subtotal"
        LR2 = ws.Range("D" & Rows.Count).End(xlUp).Row  ' coping all data from sheet.
        
        ' copy from sheets to summary sheet
        
        ws.Range("D5:p" & LR2).Copy Destination:=Sheets("Summary").Range("A" & LR1)
    End If
Next ws
Application.ScreenUpdating = True
End Sub

 

[Fluff]

Try making this mod

ws.Range("D5:p" & LR2[COLOR=#ff0000]-1[/COLOR]).Copy Destination:=Sheets("Summary").Range("A" & LR1)

 

[SAMHOTONY]

Need some help. want to change code below , dont know how to code to select one row above to text subtotal [ range. D4: column P row (one row above text ``subtotal)] `i have vba code as follows :

Public Sub CopyToSummaryTest()
Dim ws  As Worksheet
   Dim LR1 As Long
    Dim LR2 As Long
    Dim MyRng As Long
Application.ScreenUpdating = False


 
 For Each ws In ActiveWorkbook.Worksheets


        If ws.Name <> "Summary" And (Left(ws.Name, 1) = "1" Or Left(ws.Name, 1) = "4" Or Left(ws.Name, 1) = "6" Or Left(ws.Name, 1) = "7") Then
    
             For Each cell In ws.UsedRange.Cells


                 If LCase(cell.Value) = "subtotal" Then
                
                'want to change code below ,  dont know how to code to select one row above to text subtotal [ range. D4: column P row (one row above subtotla)]
                LR2 = Sheets(ws.Name).Range("d" & Rows.Count).End(xlUp).Row ' how to set row above subtotal text
                
                       ' cell.Value = cell.Value.Offset(-1, 0).Value
                        LR1 = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row + 1
                        
                        ws.Range("D5:p" & LR2).Copy Destination:=Sheets("Summary").Range("A" & LR1)
                 End If
        
             Next
        
        End If
    Next ws
    
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Have you tried my suggestion in post#2?

 

[SAMHOTONY]

Have you tried my suggestion in post#2?

Hi Fluff, I need to select range from one row above where match Text `subtotal`. your post will go one low above from last row of data what i don`t want. sheets having more row after sub total what do need to copy to summary sheet , only need row above from subtotal. Could you please have a look my VBA code and advise what code i need to select rang row above text `subtotal`.

 

[Fluff]

Without being able to see your data, it's very difficult to help.
Can you please post a sample of your data?
There are tools to help with that here https://www.mrexcel.com/forum/about-board/508133-attachments.html
And a test board here, where you can try them out https://www.mrexcel.com/forum/test-here/