VBA如何定位列头为“Unique ID”的列并复制该列第2行及以下内容

Dim ws As Worksheet
Dim targetCol As Range
Dim lastRow As Long

' 绑定操作工作表
Set ws = ActiveWorkbook.Worksheets("Sheets1")

' 在第1行查找列头为「Unique ID」的列，如需模糊匹配可将LookAt参数改为xlPart
Set targetCol = ws.Rows(1).Find(What:="Unique ID", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

' 未找到对应列时抛出提示终止运行
If targetCol Is Nothing Then
    MsgBox "未找到指定列头，请检查工作表配置", vbExclamation
    Exit Sub
End If

' 统计目标列最后一行有数据的行号
lastRow = ws.Cells(ws.Rows.Count, targetCol.Column).End(xlUp).Row

' 目标列仅表头无数据时终止运行
If lastRow < 2 Then
    MsgBox "目标列无有效数据可复制", vbExclamation
    Exit Sub
End If

' 复制目标列第2行到最后一行的全部内容
ws.Range(ws.Cells(2, targetCol.Column), ws.Cells(lastRow, targetCol.Column)).Copy

核心调整说明 #

• 取消写死的D列引用，通过Find方法动态匹配第1行的「Unique ID」列头，自动获取对应列号
• 行号统计改为针对目标列单独统计，避免其他列数据长度不一致导致的复制范围错误
• 新增两处异常拦截逻辑，避免无匹配列、无有效数据时的运行时报错
• 复制完成后可根据实际需求补充粘贴逻辑，如需粘贴数值可追加代码：Sheets("目标表名").Range("起始单元格").PasteSpecial xlPasteValues

内容的提问来源于stack exchange，提问作者Celeste