Isso irá ignorar cabeçalhos de coluna e não excluirá os dados das células originais. Dependendo da sua planilha, você pode precisar alterar os valores das colunas.
Sub Macro1()
Const firstRowWithData = 2 ' assumes labels in row 1
Dim anyWS As Worksheet
Dim copyRange As Range
Dim CP As Integer
For Each anyWS In ThisWorkbook.Worksheets
For CP = Range("B1").Column To Range("D1").Column
Set copyRange = anyWS.Range(anyWS.Cells(2, CP).Address & ":" & _
anyWS.Cells(Rows.Count, CP).End(xlUp).Address)
copyRange.Copy anyWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Next
Next
End Sub
antes
A Header B Header C Header
a b c
a b c
a b c
depois de
A Header B Header C Header
a b c
a b c
a b c
b
b
b
c
c
c
Em seguida, exclua manualmente as colunas originais.