求助判断并自动填充公式

zlzwjbnn123

需要实现将sheet1中，从B列到H列的公式实现下拉覆盖至A列最下方有值得行。每个列的公式都不一样，用下面代码写的时候太复杂，当列再多一些就写不过来了，求助大佬们简化下！！！
Sub 下拉填充()

    Dim jRow&, zRow&   

    jRow = Sheet8.Range("A2").End(xlDown).row '计算A列向下最后一个非空行
    zRow = Sheet8.Range("B2").End(xlDown).row  

    If jRow > zRow Then

        Sheet8.Range("B2").AutoFill Destination:=Sheet8.Range("B2:B" & jRow)
        Sheet8.Range("C2").AutoFill Destination:=Sheet8.Range("C2:C" & jRow)
        Sheet8.Range("D2").AutoFill Destination:=Sheet8.Range("D2:D" & jRow)
        Sheet8.Range("E2").AutoFill Destination:=Sheet8.Range("E2:E" & jRow)
        Sheet8.Range("F2").AutoFill Destination:=Sheet8.Range("F2:F" & jRow)
        Sheet8.Range("G2").AutoFill Destination:=Sheet8.Range("G2:G" & jRow)

    End If

End Sub

zgwei050

1. Sub 下拉填充()
   
2. Dim jRow&, zRow&
   
3. Dim xColumn&, j&
   
4.     With Sheet1
   
5.         jRow = .Range("A1").End(xlDown).Row '计算A列向下最后一个非空行
   
6.         zRow = .Range("B1").End(xlDown).Row '计算B列向下最后一个非空行
   
7.         xColumn = 6     'B列到G列共6列
   
8.         If jRow > zRow Then
   
9.             For j = 1 To xColumn
   
10.                 .Cells(zRow, j + 1).AutoFill Destination:=.Range(.Cells(zRow, j + 1), .Cells(jRow, j + 1))  '填充
    
11.             Next
    
12.         End If
    
13.     End With
    
14. End Sub

复制代码

zlzwjbnn123

@金樽空对月
艾特大佬

zgwei050

填充.rar (22.36 KB, 下载次数: 12)

2020-10-13 19:42 上传

点击文件名下载附件

zlzwjbnn123

非常感谢楼上大佬！