change code form implementation in the same file to external file to copy lastrow

Hi
I want to copy the data after the last row containing a zero for column G of each name of column C , and ignore all the data that precedes the last row with a zero for the same name if the last row contains a zero for column G for a specific name . if there are no data under it the last row with a zero , then it should be ignored and not copied But if there is absolutely no last row that contains a value of zero for a specific name, then all the data for the name is copied.
I put what I want the result in accounts sheet for the file 2023 and import from filter sheet for BOX1 file . should replace data every time run the macro .
here is Marc L's code works in the same file in CLEAN sheet( but delete clean sheet to implement in other file ) .

Option Explicit

Sub Demo1()
         Const C = "CLEAN", S = "-"
           Dim Rf(1) As Range, F%(), R&, L&
           Sheets(C).UsedRange.Offset(1).Clear
    With [A1].CurrentRegion.Resize(, 8).Columns
           Set Rf(0) = .Item(7).Find(S, , xlValues, 1, , 1)
        If Not Rf(0) Is Nothing Then
            ReDim F(1 To .Rows.Count, 0)
            R = Rf(0).Row
        Do
            L = Rf(0).Row
            F(L, 0) = 1
            Set Rf(1) = .Item(3).Find(Rf(0)(1, -3), Rf(0)(1, -3), , , , 2)
          While Rf(1).Row < L And Rf(1)(1, 5)
              F(Rf(1).Row, 0) = 1
            Set Rf(1) = .Item(3).FindPrevious(Rf(1))
          Wend
               Set Rf(0) = .Item(7).Find(S, Rf(0), , , , 1)
        Loop Until Rf(0).Row = R
             Erase Rf
             Union(.Item(8), [I1:I2]).Font.ColorIndex = 2
            .Item(8) = F
             [I1:I2] = 0
            .AdvancedFilter 2, [I1:I2], Sheets(C).[A1:G1]
             Union(.Item(8), [I1:I2]).Clear
        End If
    End With
End Sub

Hi,

attach the link of your original thread in order I can check something …

thanks Marc
here is the link
https://www.excelforum.com/excel-pro...ml#post5782098

According to your new rules my VBA demonstration revisited for starters :

Option Explicit

Sub Demo1r()
  Const C = "accounts", S = "-", W = "file 2023.xlsm"
    Dim P$, V, Rf(1) As Range, F%(), R&, L&
        P = Parent.Path & "\" & W
    Do
        V = Evaluate("ISREF('[" & W & "]" & C & "'!A1)")
        If IsError(V) Then Beep: Exit Sub
        If Not V Then If Dir(P) > "" Then Workbooks.Open P, 0 Else Beep: Exit Sub
    Loop Until V
        Workbooks(W).Sheets(C).UsedRange.Offset(1).Clear
    With [A1].CurrentRegion.Resize(, 8).Columns
           Set Rf(0) = .Item(7).Find(S, , xlValues, 1, , 1)
        If Not Rf(0) Is Nothing Then
            ReDim F(1 To .Rows.Count, 0)
            R = Rf(0).Row
        Do
            L = Rf(0).Row
            F(L, 0) = 1
            Set Rf(1) = .Item(3).Find(Rf(0)(1, -3), Rf(0)(1, -3), , , , 2)
          While Rf(1).Row < L And Rf(1)(1, 5)
              F(Rf(1).Row, 0) = 1
            Set Rf(1) = .Item(3).FindPrevious(Rf(1))
          Wend
               Set Rf(0) = .Item(7).Find(S, Rf(0), , , , 1)
        Loop Until Rf(0).Row = R
             Erase Rf
             Union(.Item(8), [I1:I2]).Font.ColorIndex = 2
            .Item(8) = F
             [I1:I2] = 0
            .AdvancedFilter 2, [I1:I2], Workbooks(W).Sheets(C).[A1:G1]
             Union(.Item(8), [I1:I2]).Clear
        End If
    End With
End Sub

► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

thanks very much for your assistance

Thanks for the rep' !

My demonstration works whatever if the result workbook is already opened or not if located in the same folder than the source workbook …