السلام عليكم و رحمة الله
أخي جرب هذا الكود
Sub FromAllSheets()
Dim ws As Worksheet, Dws As Worksheet, LR As Long
Set Dws = Sheets("Form")
For Each ws In Sheets
If ws.Name <> "Form" Then
LR = Dws.Range("D" & Rows.Count).End(xlUp).Row + 1
If WorksheetFunction.CountA(ws.Range("b2:b" & LR)) <> 0 Then
ws.Range("A2:C" & ws.Range("b" & Rows.Count).End(xlUp).Row).Copy
Dws.Range("b" & LR).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
End If
End If
Next ws
Application.CutCopyMode = False
Dws.Range("B" & LR).Select
End Sub