Copy Paste Rearrange Columns



Option Base 1
Dim NewCols(), xc

Sub CopyMgr()
ReDim NewCols(9)
xc = 0
Check.Show
End Sub

Sub AutoArrange(CFrm, Cto)
Rg = CFrm & ":" & CFrm
Ad = Cto & 1

With ThisWorkbook.Sheets("Triple List")
.Activate
.Columns(Rg).Select
Selection.Copy
Sheets("Sheet2").Select
Range(Ad).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End With
End Sub
Sub StoreRefs()
CR = ActiveCell.Address
KK = Mid(CR, 2, 1)
Check.CellRef.Text = KK
xc = xc + 1
NewCols(xc) = KK
End Sub
Sub CopyThis()
Check.Hide
For idx = 1 To xc
TCol = Chr(64 + idx)
AutoArrange NewCols(idx), TCol
Next idx
End Sub
###################FORM##############################

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Check
Caption = "UserForm1"
ClientHeight = 3015
ClientLeft = 120
ClientTop = 465
ClientWidth = 4560
OleObjectBlob = "Check2.frx":0000
ShowModal = 0 'False
StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "Check"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub GetCellRef_Click()
StoreRefs
End Sub

Private Sub GoCopy_Click()
CopyThis

End Sub