Option Explicit

Sub swapcolumns()
    ' David McRitchie, 2004-01-05, http://www.mvps.org/dmcritchie/swap.htm
    Dim xlong As Long
    If Selection.Areas.Count <> 2 Then
       MsgBox "Must have exactly two areas for swap." & Chr(10) _
         & "You have " & Selection.Areas.Count & " areas."
       Exit Sub
    End If
    If Selection.Areas(1).Rows.Count <> Cells.Rows.Count Or _
       Selection.Areas(2).Rows.Count <> Cells.Rows.Count Then
       MsgBox "Must select entire Columns, insufficient rows"
       Exit Sub
    End If
    Dim areaSwap1 As Range, areaSwap2 As Range, onepast2 As Range
    '--verify that Area 2 columns follow area 1 columns
    '--so that adjacent single column swap will work.
    If Selection.Areas(1)(1).Column > Selection.Areas(2)(1).Column Then
       Range(Selection.Areas(2).Address & "," & Selection.Areas(1).Address).Select
       Selection.Areas(2).Activate
    End If
    Set areaSwap1 = Selection.Areas(1)
    Set areaSwap2 = Selection.Areas(2)
    Set onepast2 = areaSwap2.Offset(0, areaSwap2.Columns.Count).EntireColumn
    areaSwap2.Cut
    areaSwap1.Resize(, 1).EntireColumn.Insert Shift:=xlShiftToRight
    areaSwap1.Cut
    onepast2.Resize(, 1).EntireColumn.Insert Shift:=xlShiftToRight
    Range(areaSwap1.Address & "," & areaSwap2.Address).Select
    xlong = ActiveSheet.UsedRange.Rows.Count  'correct lastcell
End Sub

Sub swapRows()
    ' David McRitchie, 2004-01-05, http://www.mvps.org/dmcritchie/swap.htm
    Dim xlong As Long
    If Selection.Areas.Count <> 2 Then
       MsgBox "Must have exactly two areas for swap." & Chr(10) _
         & "You have " & Selection.Areas.Count & " areas."
       Exit Sub
    End If
    If Selection.Areas(1).Columns.Count <> Cells.Columns.Count Or _
       Selection.Areas(2).Columns.Count <> Cells.Columns.Count Then
       MsgBox "Must select entire Rows, insufficient columns"
       Exit Sub
    End If
    Dim areaSwap1 As Range, areaSwap2 As Range, onepast2 As Range
    '--verify that Area 2 rows follow area 1 rows
    '--so that adjacent single column swap will work.
    If Selection.Areas(1)(1).Row > Selection.Areas(2)(1).Row Then
       Range(Selection.Areas(2).Address & "," & Selection.Areas(1).Address).Select
       Selection.Areas(2).Activate
    End If
    Set areaSwap1 = Selection.Areas(1)
    Set areaSwap2 = Selection.Areas(2)
    Set onepast2 = areaSwap2.Offset(areaSwap2.Rows.Count, 0).EntireRow
    areaSwap2.Cut
    areaSwap1.Resize(1).EntireRow.Insert Shift:=xlShiftDown
    areaSwap1.Cut
    onepast2.Resize(1).EntireRow.Insert Shift:=xlShiftDown
    Range(areaSwap1.Address & "," & areaSwap2.Address).Select
    xlong = ActiveSheet.UsedRange.Columns.Count  'correct lastcell
End Sub