Crear un ciclo en macro para copiar y generar hojas

¡ Hola !
Tengo el siguiente codigo, que consta de 3 repeticiones del mismo procedimiento, como puedo programarlo para que solo escriba el proceso y se vaya cambiando de acuerdo al numero de columnas que tenga activas en mi hoja llamada "Creacion de layers" ????


Sub Copy()
'
' Copy Macro
'
' Acceso directo: Ctrl+Mayús+C
'
Columns("B:B").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Hoja2").Select
Sheets("Hoja2").Name = "Layer_1"
Sheets("Layer_1").Select
With ActiveWorkbook.Sheets("Layer_1").Tab
.Color = 15773696
.TintAndShade = 0
End With
Sheets("Creación de Layers").Select

Columns("C:C").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Hoja3").Select
Sheets("Hoja3").Name = "Layer_2"
Sheets("Layer_2").Select
With ActiveWorkbook.Sheets("Layer_2").Tab
.Color = 15773696
.TintAndShade = 0
End With
Sheets("Creación de Layers").Select

Columns("D:D").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Hoja4").Select
Sheets("Hoja4").Name = "Layer_3"
Sheets("Layer_3").Select
With ActiveWorkbook.Sheets("Layer_3").Tab
.Color = 15773696
.TintAndShade = 0
End With
Sheets("Creación de Layers").Select
End Sub


De antemano, muchas gracias a todos los que me puedan ayudar.