根据单元格值将行从两个或多个Excel工作表复制到另一个

Question

enter image description here I don't think that could match the mines, anyway,

The difference is copying from more than one sheet to another based on a cell value and not do it with macro VBA but with:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range).

In fact I tried this but it doesn't give a good result:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    For Each Sh In ThisWorkbook.Sheets
        If Not Sh.Name = "Archive" Then
            If Cells(Target.Row, 3) = "delivered" Then Cells(Target.Row, 3).EntireRow.Copy Sheets("Archive").Range("A" & Rows.Count) _
              .End(xlUp).Offset(1, 0)
        End If 
    Next Sh
End Sub

Thank's for helping me.

Answer 1

I post herewith the solution of my question, thank you PEH and thank's for the forum member.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Not Sh.Name = "Archive" Then lastcolumn = Cells(1, Columns.Count).End(xlToLeft).Column If Sh.Cells(Target.Row, 3) = "delivered" And Sh.Cells(Target.Row, lastcolumn) <> "" Then Range(Cells(Target.Row, 1), Cells(Target.Row, lastcolumn)).Copy _ Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1) End If End If End Sub