Try this
Sub CombineRemoveDups()
Dim x&, i&, r As Long
Application.Calculation = xlCalculationManual
Sheets(Sheets.Count).Cells.Clear
For i = 1 To Sheets.Count - 1
    With Sheets(i)
        For x = 1 To .UsedRange.Columns.Count
            r = WorksheetFunction.CountA(.Columns(x)) - 1
            If r > 0 Then Sheets(Sheets.Count).Cells(50000, i).End(xlUp).Offset(1).Resize(r).Value = Range(.Cells(2, x), .Cells(50000, x).End(xlUp)).Value
        Next x
    End With
    Sheets(Sheets.Count).Columns(i).RemoveDuplicates 1, xlNo
Next i
Application.Calculation = xlCalculationAutomatic
End Sub