Sub copyRange() Dim ws As Worksheet Dim lastCol As Long Dim todayDate As Date '声明一个新变量，避免与内置函数 Today() 冲突 Dim copyRange As Range '声明一个新变量，存储需要复制的范围 Dim searchRange As Range '声明一个新变量，存储查找范围 '获取当前日期 todayDate = Format(Date, "m月d日") '指定工作表 Set ws = ThisWorkbook.Worksheets("中转场地效益看板") '指定查找范围为第7行至第7行的最后一列 Set searchRange = ws.Range("G7:AK7") '查找今天日期所在的列号，如果不存在则给出提示并退出 If searchRange.EntireColumn.Find(What:=todayDate, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then MsgBox "今天的日期没有找到！" Exit Sub Else lastCol = searchRange.EntireColumn.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 '弹出提示框 MsgBox "复制成功！" End Sub已经修改了还是提示今日日期没找到

如果您按照上述方法修改了代码，但仍然提示找不到今天的日期，那么可能是因为日期格式不匹配导致的。请检查单元格 G7 中的日期格式是否为 "m月d日" 格式，如果不是，请将代码中的日期格式也相应地修改为单元格中的日期格式。

另外，请注意，代码中的日期格式必须与单元格中的日期格式完全匹配，包括年份、月份、日期的顺序以及分隔符等。例如，如果单元格中的日期格式为 "6月11日"，那么代码中的日期格式也必须为 "m月d日"，不能是其他格式，比如 "d日m月" 或者 "mm/dd/yyyy" 等。

相关问题

Sub copyRange() Dim ws As Worksheet Dim lastCol As Long Dim todayDate As Date '声明一个新变量，避免与内置函数 Today() 冲突 Dim copyRange As Range '声明一个新变量，存储需要复制的范围 Dim searchRange As Range '声明一个新变量，存储查找范围 '获取当前日期 todayDate = Date '指定工作表 Set ws = ThisWorkbook.Worksheets("中转场地效益看板") '指定查找范围为第7行至第7行的最后一列 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 '复制第一列至今天日期所在的那一列的下一列，第2行至第372行 Set copyRange = ws.Range(ws.Cells(2, "B"), ws.Cells(372, lastCol + 1)) copyRange.Copy '弹出提示框 MsgBox "复制成功！" End Sub使这段代码复制今日日期所在那一列和AL列

您可以按照以下步骤修改代码，实现复制今日日期所在那一列和AL列：

1. 将第8行中的查找范围修改为G7:AL7，包括今日日期所在的那一列和AL列；
2. 将第18行中的复制范围修改为第一列至今日日期所在的那一列和AL列，第2行至第372行；
3. 将第21行中的提示框文字修改为“复制成功！”。

修改后的代码如下：

Sub copyRange()
    Dim ws As Worksheet
    Dim lastCol As Long
    Dim todayDate As Date '声明一个新变量，避免与内置函数 Today() 冲突
    Dim copyRange As Range '声明一个新变量，存储需要复制的范围
    Dim searchRange As Range '声明一个新变量，存储查找范围
    
    '获取当前日期
    todayDate = Date
    
    '指定工作表
    Set ws = ThisWorkbook.Worksheets("中转场地效益看板")
    
    '指定查找范围为第7行至第7行的最后一列，包括今日日期所在的那一列和AL列
    Set searchRange = ws.Range("G7:AL7")
    
    '查找今天日期所在的列号，如果不存在则给出提示并退出
    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
    
    '复制第一列至今天日期所在的那一列和AL列的下一列，第2行至第372行
    Set copyRange = ws.Range(ws.Cells(2, "B"), ws.Cells(372, lastCol + 1).Resize(, 38))
    copyRange.Copy
    
    '弹出提示框
    MsgBox "复制成功！"
End Sub

希望能够帮到您！

对象变量或with块变量为设置 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("中转场地效益看板") '指定查照日期的范围 '指定查找范围为第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 '弹出提示框 MsgBox "复制成功！" End Sub

这个错误通常是因为没有正确设置对象变量或 `With` 块变量。在这段代码中，错误可能是因为没有正确设置 `searchRange` 变量。

你可以尝试将 `searchRange` 的定义前面添加 `Dim` 关键字，以确保它是一个新的变量。另外，你还需要为 `searchRange` 变量赋值，以指定查找范围。具体来说，你可以将其定义为以下代码：

Dim searchRange As Range
Set searchRange = ws.Range("G7", ws.Cells(7, ws.Columns.Count))

这样，就可以避免出现“对象变量或 With 块变量未设置”错误。完整修改后的代码如下：

Sub copyRange()
    Dim ws As Worksheet
    Dim lastCol As Long
    Dim todayDate As Date '声明一个新变量，避免与内置函数 Today() 冲突
    Dim copyRange As Range '声明一个新变量，存储需要复制的范围
    Dim searchRange As Range '声明一个新变量，存储查找范围
    
    '获取当前日期
    todayDate = Date
    
    '指定工作表
    Set ws = ThisWorkbook.Worksheets("中转场地效益看板")
    
    '指定查找范围为第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
    
    '弹出提示框
    MsgBox "复制成功！"
End Sub