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行，依此類推。

如果您遇到的唯一問題是沒有填滿整個行，那么上述解決方案將解決該問題。 但是，如果您發現填寫錯誤的行，則需要重新考慮如何選擇該行。