Sub Sbor()
Dim Sht As Worksheet
Dim iLastRow As Long
Dim iLR As Long
Dim i As Long
  iLR = Cells(Rows.Count, "A").End(xlUp).Row + 1
  Range("A2:C" & iLR).ClearContents
    For Each Sht In Worksheets
      If Sht.Name <> "заказ" Then        ' кроме листа "заказ"
        With Sht
          iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
          For i = 2 To iLastRow
            If Not IsEmpty(.Cells(i, "J")) Then
              iLR = Cells(Rows.Count, "A").End(xlUp).Row + 1
              .Range("B" & i).Copy Cells(iLR, "A")
              .Range("J" & i).Copy Cells(iLR, "B")
              Cells(iLR, "C") = Sht.Name
            End If
          Next
        End With
      End If
    Next
End Sub