基于列标题的VBA复制和粘贴列

我希望你能帮上忙。 我想要实现的是这样的：我希望VBAsearch列标题来find包含文本“CountryCode”的标题，一旦它发现这个我想要它剪切这个列并将其粘贴到第六列。 我的代码尝试在下面，但它不能正常工作我已附加屏幕截图，以便更好地理解。

我知道Destination:=Worksheets("Sheet1").Range("E5")是错误的我只是无法看到让它粘贴到新创build的F列

屏幕截图：国家代码在列WI只是不能得到它粘贴到新的F列。 任何帮助将不胜感激。

 Sub Sample() Dim ws As Worksheet Dim aCell As Range, Rng As Range Dim col As Long, lRow As Long Dim colName As String '~~> Change this to the relevant sheet Set ws = ThisWorkbook.Sheets("Sheet1") With ws Set aCell = .Range("A1:X50").Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _ MatchCase:=False, SearchFormat:=False) '~~> If Found If Not aCell Is Nothing Then Worksheets("Sheet1").Range("W1:W3").Cut _ Destination:=Worksheets("Sheet1").Range("E5") Columns([23]).EntireColumn.Delete Columns("F:F").Insert Shift:=xlToRight, _ CopyOrigin:=xlFormatFromLeftOrAbove '~~> If not found Else MsgBox "Country Not Found" End If End With End Sub 

Answer 1

这段代码是做你正在寻找的？

 Sub Sample() Dim ws As Worksheet Dim aCell As Range, Rng As Range Dim col As Long, lRow As Long Dim colName As String '~~> Change this to the relevant sheet Set ws = ThisWorkbook.Sheets("Sheet1") With ws Set aCell = .Range("A1:X50").Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _ MatchCase:=False, SearchFormat:=False) '~~> If Found If Not aCell Is Nothing Then '~~> Cut the entire column aCell.EntireColumn.Cut '~~> Insert the column here Columns("F:F").Insert Shift:=xlToRight Else MsgBox "Country Not Found" End If End With End Sub 

Answer 2

没有必要使用删除或插入。 Range().Cut Destination:=Range()将把单元移动到你的位置。

 Sub Sample() Dim aCell As Range With ThisWorkbook.Sheets("Sheet1") Set aCell = .Rows(1).Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _ MatchCase:=False, SearchFormat:=False) If Not aCell Is Nothing Then aCell.EntireColumn.Cut Destination:=.Columns(5) Else MsgBox "Country Not Found" End If End With End Sub