Excel VBA插入行并在多张纸上复制数据

Question

我正在尝试获取正确的VBA代码，该代码将允许我将行插入到多个工作表上同一位置的已过滤表中，并复制上面整行中的所有内容。

有一个与工作簿中的每个工作表相关的复选框。 如果选中该复选框，则应将该行插入到此工作表中。

床单受密码保护。 在文件的另一个工作表中找到了密码。

我几乎已经可以工作了。 我的文件可以在以下位置找到：

https://drive.google.com/file/d/0B5HnHgSNFkFid0gwbDNMOFN1NUU/view?usp=sharing

代码如下：

    Sub Insert_Rows()

    Dim sh As Worksheet

    For Each sh In Sheets
        If sh.Name = "Sheet1" And Worksheets("Sheet4").Range("D1").Value = True Or _
            sh.Name = "Sheet2" And Worksheets("Sheet4").Range("D2").Value = True Or _
            sh.Name = "Sheet3" And Worksheets("Sheet4").Range("D3").Value = True Then
            With sh
            .Unprotect Password:=Worksheets("Sheet4").Range("A1")
                .Cells(ActiveCell.Row, 4).EntireRow.Insert
                .Range(.Cells(ActiveCell.Row, 1), .Cells(ActiveCell.Row, 4)).FillDown
                .Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=Worksheets("Sheet4").Range("A1")
            End With
        End If
    Next sh

End Sub

我遇到的问题是，并非以上行中的所有数据都被复制了。 第5列中的数据未向下复制。 我确定这与代码.Cells(ActiveCell.Row, 4) 。 我希望它复制上面的整行而不管列数。

任何帮助，不胜感激。

谢谢

Answer 1

要填充EntireRow，而不仅仅是第1列和第4列之间的范围，请替换

.Range(.Cells(ActiveCell.Row, 1), .Cells(ActiveCell.Row, 4)).FillDown

与

.Cells(ActiveCell.Row, 1).EntireRow.FillDown

（也可以写成.Rows(ActiveCell.Row).FillDown ）

注意：

请记住，ActiveCell.Row不一定引用Sheet1，Sheet2或Sheet3上的任何特殊位置。

如果当前活动的单元格是工作表Sheet4上的单元格G67，则ActiveCell.Row将计算为67，因此Sheet1（和/或Sheet2和/或Sheet3）的行66将被复制到Sheet1（和/或Sheet2和/或Sheet3）-它不会神奇地决定在Sheet1上插入第58行，在Sheet2上插入第82行，依此类推。

如果您遇到的唯一问题是没有填满整个行，那么上述解决方案将解决该问题。 但是，如果您发现填写错误的行，则需要重新考虑如何选择该行。