基于列标题的 VBA 复制和粘贴列
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/39894035/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Copy and Paste Column based of Column Heading
提问by Philip Connell
I hope you can help. What I am trying to achieve is this: I want the VBA to search through column headings to find a heading that contains the text "CountryCode" once it finds this I want it to cutthis column and paste it into the sixth column. My attempt at code is below but it not working correctly I have attached screen shots for better understanding.
我希望你能帮忙。我想要实现的是：我希望 VBA 搜索列标题以找到包含文本“CountryCode”的标题，一旦找到它，我希望它剪切此列并将其粘贴到第六列中。我的代码尝试如下，但它无法正常工作，我附上了屏幕截图以便更好地理解。
I know Destination:=Worksheets("Sheet1").Range("E5")is wrong I just cant seen to get it to paste into the newly created F Column
我知道Destination:=Worksheets("Sheet1").Range("E5")错了，我只是无法将其粘贴到新创建的 F 列中
Screen Shot: Country Code was in Column W I just cant get it to paste into the new F column. Any help would be greatly appreciated.
屏幕截图：国家代码在 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
回答by
There is no need to use Delete or Insert. Range().Cut Destination:=Range()will move the cells into position for you.
无需使用删除或插入。 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
回答by 5202456
Does this code do what you are looking for?
这段代码是否符合您的要求？
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
