求助优化一个宏，老师已帮忙编写，但是有点小瑕疵

玥儿妈妈

求助一个宏，每次执行的时候可以从月计划表复制自动粘贴周计划表【未来7天的】

格式位置一样，就是按日期提取！！

谢谢老师，高手，指点，在线等，非常感谢

gwjkkkkk

请楼主参考附件。。。

玥儿妈妈

gwjkkkkk 发表于 2023-3-5 18:42
请楼主参考附件。。。

可以用了，非常非常感谢

shiruiqiang

gwjkkkkk

玥儿妈妈 发表于 2023-3-5 18:52
可以用了，非常非常感谢

回复有用，请右下角评分。。。

玥儿妈妈

gwjkkkkk 发表于 2023-3-5 18:59
回复有用，请右下角评分。。。

我把代码复制到我的原表格
Set Rng = Sheets(2).[A1].CurrentRegion
这一句话出现需要调试，怎么能改成sheet名字“月计划“呢，谢谢

玥儿妈妈

gwjkkkkk 发表于 2023-3-5 18:59
回复有用，请右下角评分。。。

感谢高手指教！
我把代码复制到我的原表格
Set Rng = Sheets(2).[A1].CurrentRegion
这一句话出现需要调试，怎么能改成sheet名字“月计划“呢，谢谢
Set Rng = Sheets(“月计划”).[A1].CurrentRegion我这样模仿的，但是不能用

gwjkkkkk

玥儿妈妈 发表于 2023-3-5 19:10
感谢高手指教！
我把代码复制到我的原表格
Set Rng = Sheets(2).[A1].CurrentRegion

估计你不是点按钮的，引用位置不对，造成问题。。。
Option Explicit
Sub TEST()
    Dim Rng As Range, rngFind As Range, ar, i&
   
    Set Rng = Sheets("月计划").[A1].CurrentRegion
    With Sheets("周计划").[A1].CurrentRegion
        .Offset(4, 1).ClearContents
        ar = .Value
        For i = 2 To UBound(ar, 2) Step 2
        Set rngFind = Rng.Find(ar(2, i), , , xlWhole)
            If Not rngFind Is Nothing Then
                With Range(rngFind.Offset(1), rngFind.Offset(10)).Resize(, 2)
                    .Copy Sheets("周计划").Cells(5, i)
                End With
            End If
        Next i
    End With
   
    Set Rng = Nothing: Set rngFind = Nothing
    Beep
End Sub

gwjkkkkk

玥儿妈妈 发表于 2023-3-5 19:10
感谢高手指教！
我把代码复制到我的原表格
Set Rng = Sheets(2).[A1].CurrentRegion

估计没点按钮运行的宏，可改成绝对引用就没问题了。。。

玥儿妈妈

gwjkkkkk 发表于 2023-3-5 19:20
估计没点按钮运行的宏，可改成绝对引用就没问题了。。。

老师，提示CurrentRegion作用range失败
老师，我的周计划是sheet9  月计划是sheet3