Sub copyRange() Dim ws As Worksheet Dim lastCol As Long Dim todayDate As Date '声明一个新变量，避免与内置函数Today()冲突 Dim copyRange As Range '声明一个新变量，存储需要复制的范围 '获取当前日期 todayDate = Date '指定工作表 Set ws = ThisWorkbook.Worksheets("中转场地效益看板") '指定查照日期的范围 Set searchRange = ws.Range("G7:AK7") '查找今天日期所在的列号，如果不存在则给出提示并退出 If searchRange.Find(What:=todayDate, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then MsgBox "今天的日期没有找到！" Exit Sub Else lastCol = searchRange.Find(What:=todayDate, LookIn:=xlValues, LookAt:=xlWhole).Column End If '复制B列至今天日期所在的那一列，第2行至第372行 Set copyRange = ws.Range(ws.Cells(2, "B"), ws.Cells(372, lastCol)) copyRange.Copy '弹出提示框 MsgBox "复制成功！" End Sub在这段代码上修改 是复制范围为单元格包含当前日期的一列再向右平移一列

如果你想要修改这段代码，将复制的范围改为单元格包含当前日期的一列再向右平移一列，只需要修改如下代码：

'指定查找范围为第7行至第7行的最后一列
Set searchRange = ws.Range("G7", ws.Cells(7, ws.Columns.Count))

'查找今天日期所在的列号，如果不存在则给出提示并退出
If searchRange.Find(What:=todayDate, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
    MsgBox "今天的日期没有找到！"
    Exit Sub
Else
    lastCol = searchRange.Find(What:=todayDate, LookIn:=xlValues, LookAt:=xlWhole).Column
End If

'复制第一列至今天日期所在的那一列的下一列，第2行至第372行
Set copyRange = ws.Range(ws.Cells(2, "A"), ws.Cells(372, lastCol + 1))
copyRange.Copy

在上面的代码中，首先指定了查找范围为第7行至第7行的最后一列，然后使用 `Find` 方法查找包含今天日期的列号。接着，将需要复制的范围指定为第一列至今天日期所在的那一列的下一列，第2行至第372行，并将其复制到剪贴板中。