variable

[biedubbeljoe]

Ik heb een sorteer script voor een kolom telefoonnummer gemaakt. Ik wil echter dat ik zelf kan opgeven (userinput) op welke kolom ik de bewerking uitvoer. De macro is nu alleen voor kolom A.
Voorwaarde is dat alle orginele kolommen aan het einde van de bewerking op dezelfde plaats staan en de nieuw gesorteerde kolom in bijv. kolom AA.

Zie hieronder het script:


Sub macro()
'
' Macro Column A
'
' Select column A
Columns("A:A").Select

' Cel properties set numbers from default 2 to 0
Selection.NumberFormat = "0"

' Select the column right next to A and insert new column
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Range("B1").Select

' in the new column select B1 activate Fx (paste function)



ActiveCell.FormulaR1C1 = "=TRIM(C[-1])"
Selection.AutoFill Destination:=Columns("B:B"), Type:=xlFillDefault
Columns("B:B").Select
ActiveWindow.ScrollRow = 1
Selection.Copy

' select 'delete all blanks'
' select column A (OK)
' select cel B1 from range 1 till end, copy column B
' and past only the values
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
' insert new column next right to column B
Columns("C:C").Select
' select cel C1 and select Fx (past function) align to the right
' select column B and give the value 9 for 9 numbers (OK)
'
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("C1").Select
ActiveCell.FormulaR1C1 = "=RIGHT(C[-1],9)"
' select cel C1 from range 1 till end, copy column C
' and past only the values
Selection.AutoFill Destination:=Columns("C:C"), Type:=xlFillDefault
Columns("C:C").Select
ActiveWindow.ScrollRow = 1
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll ToRight:=13

' copy new sorted phonelist to column AA
Range("AA1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With

' Color the new sorted phonelist
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With

' delete the first and second insert work columns
ActiveWindow.ScrollColumn = 1
Columns("B:C").Select
Selection.Delete Shift:=xlToLeft
Range("J1").Select
' After deleting the two work columns, the new sorted column
' is placed two places left of column AA
End Sub