ある範囲の列の中に特定のテキストを持つセルの前に列を挿入しようとしています。最後のセルは空ではありません。それを行う方法はありますか？

Question

ある範囲の列の中に特定のテキストを持つセルの前に列を挿入しようとしています。最後のセルは空ではありません。そして、新しい列に列をカット/ペーストし、VBAを使用して内容が切り取られた列を削除します。 Select/Activate機能を使用しない方法はありますか？

私はそのマクロの部分を記録しましたが、マクロが指定された列に限定されるようにループを作成する方法はわかりません。

This image is the example of columns which I want to get my desired results

私はこれを達成しようとしています：値「XYZ」

と

1. 検索細胞は、細胞の左側に列を挿入
2. コピー列全体を見つけました新しく挿入された列に値 "abc"を持つ特定のセルを使用します。
3. カット/ペースト後に列を削除します。

は、ここに記録部分です：

'Cells.Select 
Columns("H:H").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("J:J").Select 
Selection.Cut 
Columns("H:H").Select 
ActiveSheet.Paste 
Columns("J:J").Select 
Selection.Delete Shift:=xlToLeft 
Columns("K:K").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("M:M").Select 
Selection.Cut 
Columns("K:K").Select 
ActiveSheet.Paste 
Columns("M:M").Select 
Selection.Delete Shift:=xlToLeft 
Columns("N:N").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("P:P").Select 
Selection.Cut 
Columns("N:N").Select 
ActiveSheet.Paste 
Columns("P:P").Select 
Selection.Delete Shift:=xlToLeft 
Columns("Q:Q").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("S:S").Select 
Selection.Cut 
Columns("Q:Q").Select 
ActiveSheet.Paste 
Columns("S:S").Select 
Selection.Delete Shift:=xlToLeft 
Columns("T:T").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("V:V").Select 
Selection.Cut 
Columns("T:T").Select 
ActiveSheet.Paste 
Columns("V:V").Select 
Selection.Delete Shift:=xlToLeft 
Columns("W:W").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("Y:Y").Select 
Selection.Cut 
Columns("W:W").Select 
ActiveSheet.Paste 
Columns("Y:Y").Select 
Selection.Delete Shift:=xlToLeft 
Columns("Z:Z").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("AB:AB").Select 
Selection.Cut 
Columns("Z:Z").Select 
ActiveSheet.Paste 
Columns("AB:AB").Select 
Selection.Delete Shift:=xlToLeft 
Columns("AC:AC").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("AE:AE").Select 
Selection.Cut 
Columns("AC:AC").Select 
ActiveSheet.Paste 
Columns("AE:AE").Select 
Selection.Delete Shift:=xlToLeft 
Columns("AF:AF").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("AH:AH").Select 
Selection.Cut 
Columns("AF:AF").Select 
ActiveSheet.Paste 
Columns("AH:AH").Select 
Selection.Delete Shift:=xlToLeft 
Columns("AI:AI").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("AK:AK").Select 
Selection.Cut 
Columns("AI:AI").Select 
ActiveSheet.Paste 
Columns("AK:AK").Select 
Selection.Delete Shift:=xlToLeft 
Columns("AL:AL").Select 
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
Columns("AN:AN").Select 
Selection.Cut 
Columns("AL:AL").Select 
ActiveSheet.Paste 
Columns("AN:AN").Select 
Selection.Delete Shift:=xlToLeft 

Answer 1

MoveXYZtoTheLeftOfABCは、文字列ABCとXYZを探します。両方が見つかった場合は、EntireColumnをxyz EntireColumnをabcの列の右に移動します。

使用法：

前MoveXYZtoTheLeftOfABC "abc","xyz"

Sub MoveXYZtoTheLeftOfABC(abc As String, xyz As String) 

    Dim rABC As Range, rXYZ As Range 

    Set rABC = ActiveSheet.Cells.Find(What:=abc) 

    If Not rABC Is Nothing Then 
     Set rXYZ = ActiveSheet.Cells.Find(What:=xyz) 
     If Not rXYZ Is Nothing Then 
      rXYZ.EntireColumn.Cut 
      rABC.EntireColumn.Insert Shift:=xlToLeft 
     End If 
    End If 

End Sub