上次发帖沉了，再次求助

白云家

各位大神，上次发帖，由于疫情，事情太多未能及时和热心回复的大神沟通，表达自己的需求，帖子沉了。顾再次发帖，希望有大神帮忙解决。
介绍下情况：图一这个工作表的黄框信息是通过下拉框引用“引用工作表”的信息，蓝框是手动输入的信息，红框是通过公式引用经过一定运算后“修正表”的数据，绿框是通过公式引用箭头对应的信息（=IF(OR(A5="",A5=0),"",$AC$2)），因涉及到一些运算规则我把初算的表删除，把修正的运算公式也去了。
我想在大神的帮助下实现在：图一点击录入按钮后，图1的相关信息自动录入到图2中去，而不是有些是把公式录入到图2中去，谢谢！
另外感谢之前的有些大佬给的一些方案，使我能够实现这个附件的某些功能，谢谢！

cutecpu

Sub demo()
   rs = Sheets(1).[c65536].End(xlUp).Row
   If rs < 4 Then Exit Sub
   With Sheets(4)
      r = .[a:a].Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      Sheets(1).Range("c4:z" & rs).Copy
      .Range("a" & r + 1).PasteSpecial Paste:=xlPasteValues
   End With
End Sub


祝順心，南無阿彌陀佛！

白云家

cutecpu 发表于 2022-10-26 14:12
Sub demo()
   rs = Sheets(1).[c65536].End(xlUp).Row
   If rs < 4 Then Exit Sub

你好，能不能再麻烦你看下是那个地方没对上运行不起来，还有你的demo文件里找不到某块不知道为什么

图3

cutecpu

白云家 发表于 2022-10-26 15:59
你好，能不能再麻烦你看下是那个地方没对上运行不起来，还有你的demo文件里找不到某块不知道为什么

您好，我這邊沒有wps可以測試喔~~
您要不要直接貼上面的代碼跑跑看

白云家

cutecpu 发表于 2022-10-26 17:48
您好，我這邊沒有wps可以測試喔~~
您要不要直接貼上面的代碼跑跑看

我这边代码本来是这样的：
Sub lu()
With Sheets("录入")
r = .Range("b65536").End(xlUp).Row + 1
If r < 4 Then r = 4
rs = Range("a65536").End(xlUp).Row
If rs < 4 Then Exit Sub
Range("a4:aa" & rs).Copy .Range("b" & r)
    For x = r To r + rs - 4
    .Range("a" & x) = .Range("a" & x - 1) + 1
    Next
End With
MsgBox "录入完成"
End Sub

但是点击录入后，图一里到AA列的信息除红框外其它都能录到录入这个工作表中。按照你的意见改为如下公式：
Sub lu()
   rs = Sheets(1).[c65536].End(xlUp).Row
   If rs < 4 Then Exit Sub
   With Sheets(4)
      r = .[a:a].Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      Sheets(1).Range("c4:z" & rs).Copy
      .Range("a" & r + 1).PasteSpecial Paste:=xlPasteValues
   End With
End Sub

点击录入后只有部份信息能录到图5红框这来，你能帮忙再看看吗？

白云家

cutecpu 发表于 2022-10-26 17:48
您好，我這邊沒有wps可以測試喔~~
您要不要直接貼上面的代碼跑跑看

辛苦你了大神

cutecpu

白云家 发表于 2022-10-27 13:33
我这边代码本来是这样的：
Sub lu()
With Sheets("录入")

Sub lu()
   rs = Sheets(1).[c65536].End(xlUp).Row
   If rs < 4 Then Exit Sub
   With Sheets(4)
      r = .[a:a].Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      Sheets(1).Range("a4:aa" & rs).Copy
      .Range("a" & r + 1).PasteSpecial Paste:=xlPasteValues
   End With
End Sub

白云家

cutecpu 发表于 2022-10-27 13:39
Sub lu()
   rs = Sheets(1).[c65536].End(xlUp).Row
   If rs < 4 Then Exit Sub

大神 ，我是想点击录入按钮后，图6虚线里的信息录入到"录入"这个工作表里，但按你这个代码点击录入后，信息是录到同张表里的红框位置了，能帮忙再看看吗？
我是想点击如入后相关信息自动录到依次录入这张表格的，不是会覆盖已有内容的那种。是录入到这张：图7

cutecpu

白云家 发表于 2022-10-28 11:08
大神 ，我是想点击录入按钮后，图6虚线里的信息录入到"录入"这个工作表里，但按你这个代码点击录入后，信 ...

Sub lu()
   rs = sheets(1).[c65536].End(xlUp).Row
   If rs < 4 Then Exit Sub
   With Sheets("录入")
      r = .[a:a].Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      Sheets(1).Range("a4:aa" & rs).Copy
      .Range("a" & r + 1).PasteSpecial Paste:=xlPasteValues
   End With
End Sub

白云家

cutecpu 发表于 2022-10-28 12:30
Sub lu()
   rs = sheets(1).[c65536].End(xlUp).Row
   If rs < 4 Then Exit Sub

你好，大神在你的代码基础上小改了下，可以跑了，不过如果我在录入这个页面里A这列设为保护状态的话需然能够跑，但还是会提示我要调试这列代码： .Range("b" & r).PasteSpecial Paste:=xlPasteValues，能帮忙再看看吗？