Sub Macro1()
      
     Dim a(), b(), c(), res()
     Dim lngLastRow1 As Long, lngLastRow2 As Long, lngLastRow3 As Long, lngLastRow4 As Long
     Dim i As Long, j As Long, k As Long, r As Long
      
     lngLastRow1 = Cells(Rows.Count, "A").End(xlUp).Row
     lngLastRow2 = Cells(Rows.Count, "B").End(xlUp).Row
     lngLastRow3 = Cells(Rows.Count, "C").End(xlUp).Row
     lngLastRow4 = Cells(Rows.Count, "D").End(xlUp).Row
      
     If lngLastRow4 > 1 Then
         Range("D2:D" & lngLastRow4).Value = ""
     End If
      
     a() = Range("A1:A" & lngLastRow1).Value
     b() = Range("B1:B" & lngLastRow1).Value
     c() = Range("C1:C" & lngLastRow1).Value
      
     ReDim res(1 To (lngLastRow1 - 1) * (lngLastRow2 - 1) * (lngLastRow3 - 1), 1 To 1)
      
     For i = 2 To lngLastRow1
         For j = 2 To lngLastRow2
             For k = 2 To lngLastRow3
                 r = r + 1
                 res(r, 1) = a(i, 1) & " " & b(j, 1) & " " & c(k, 1)
             Next k
         Next j
     Next
      
     Range("D2").Resize(UBound(res), 1).Value = res
      
End Sub

Sub ikki()
Dim b$(), n1&, n2&, n3&, i&, j&, k&, n&
With Sheets("Лист1")
n1 = .Cells(.Rows.Count, 1).End(xlUp).Row
n2 = .Cells(.Rows.Count, 2).End(xlUp).Row
n3 = .Cells(.Rows.Count, 3).End(xlUp).Row
ReDim b(1 To (n1 - 1) * (n2 - 1) * (n3 - 1), 1 To 1)
For i = 2 To n1
For j = 2 To n2
For k = 2 To n3
n = n + 1
b(n, 1) = .Cells(i, 1) & " " & .Cells(j, 2) & " " & .Cells(k, 3)
Next k, j, i
.[d2].Resize(UBound(b)).Value = b
End With
End Sub

Sub qqq()
   Dim i&, j&, k&, r&: r = 2
   For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
   For j = 2 To Cells(Rows.Count, 2).End(xlUp).Row
   For k = 2 To Cells(Rows.Count, 3).End(xlUp).Row
     Cells(r, 4) = Cells(i, 1) & " " & Cells(j, 2) & " " & Cells(k, 3): r = r + 1
Next k, j, i
End Sub