Cut & insert columns not working
I've written a macro to look for a cell containing "othermed" in row 1.
If it finds "othermed", it test to see if the cell to the right is
blank. If that cell is not blank, it creates a range from the cell to
the last cell in row 1 with text. It then cuts those columns to the
right of the one containing "othermed" and pastes them in 5 columns to
the left of it. Well, it's supposed to.
Sub ColumnMove()
Dim rOthrMed As Range
Dim rTtl As Range
Dim rMove As Range
'Application.ScreenUpdating = False
Range("a1").Select
Selection.CurrentRegion.Select
Set rTtl = Range(Selection, Selection.End(xlToRight))
Set rOthrMed = rTtl.find("othermed", LookIn:=xlValues)
If Not rOthrMed Is Nothing Then
If rOthrMed.Offset(0, 1).Value < "" Then
Set rMove = Range(Selection, Selection.End(xlToRight))
rMove.EntireColumn.Cut
rOthrMed.Offset(0, -5).EntireColumn.Insert<--ERROR HERE
End If
End If
Application.ScreenUpdating = True
End Sub
When I run it I get runtime error 1004, saying it can't paste because
the ranges don't match. Can anyone tell me whatsamatta?
Thanks for the help.
|