Excel不能正确地将数据从一张纸传送到另一张纸

最近我一直在制作一个电子表格，允许用户在发票模板页面上input数据，然后将这些信息保存在另一张表格上。 发票模板如下所示：

我只是随机input每个单元格。 然后，当用户按下“保存”论坛button时，来自B17：H37的数据需要移动到名为发票数据的工作表。 数据应该被input到发票数据页面上的D：G，但结果是这样的：

A：C在B17：H37以外的区域填入不同的值（如下面的代码所示）， 但是只有发票箱中的“名称”数据（B列）被复制到发票数据表中，而“小时”，“成本“和”总计“被忽略。 这里是我到目前为止的代码（从我在网上find的教程）：

Sub save_invoice() Dim rng As Range Dim i As Long Dim a As Long Dim rng_dest As Range Application.ScreenUpdating = False 'Check if invoice # is found on sheet "Invoice data" i = 1 Do Until Sheets("Invoice data").Range("A" & i).Value = "" If Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("E7") & "-" & Range("F7").Value Then 'Ask overwrite invoice #? If MsgBox("Overwrite invoice data?", vbYesNo) = vbNo Then Exit Sub Else Exit Do End If End If i = i + 1 Loop i = 1 Set rng_dest = Sheets("Invoice data").Range("D:F") 'Delete rows if invoice # is found Do Until Sheets("Invoice data").Range("A" & i).Value = "" If Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("E7") & "-" & Range("F7").Value Then Sheets("Invoice data").Range("A" & i).EntireRow.Delete i = 1 End If i = i + 1 Loop ' Find first empty row in columns D:G on sheet Invoice data Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0 i = i + 1 Loop 'Copy range B17:F37 on sheet Invoice Set rng = Sheets("Invoice").Range("B17:H37") ' Copy rows containing values to sheet Invoice data For a = 1 To rng.Rows.Count If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then rng_dest.Rows(i).Value = rng.Rows(a).Value 'Copy Invoice number Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("E7") & "-" & Range("F7").Value 'Copy Date Sheets("Invoice data").Range("B" & i).Value = Sheets("Invoice").Range("B2").Value 'Copy Project Name Sheets("Invoice data").Range("C" & i).Value = Sheets("Invoice").Range("C7").Value i = i + 1 End If Next a Application.ScreenUpdating = True End Sub 

我对VBA还是很新的，所以我感到非常困惑。 我尝试了debuggingfunction，这是代码通常拧起来的地方： For a = 1 To rng.Rows.Count If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then rng_dest.Rows(i).Value = rng.Rows(a).Value 。值。 如果你能帮我解决这个问题，我将非常感激:)

另外，作为一个方面说明，是否有办法让“合并”（列H）中的“0”的行不被传送到发票数据页面？ 感谢您的时间。

在这幅图中，我希望删除第7行和下面的所有内容，因为我没有在这些行的发票页面中input任何内容。

Answer 1

我修改了循环的结果如下：

 'Copy rows containing values to sheet Invoice data For a = 17 To 37 If WorksheetFunction.CountA(Sheets("Invoice").Range("B" & a & ":H" & a)) <> 0 Then 'Copy Invoice number Sheets("Invoice data").Range("A" & i) = Sheets("Invoice").Range("E7") & "-" & Sheets("Invoice").Range("F7") 'Copy Date Sheets("Invoice data").Range("B" & i) = Sheets("Invoice").Range("B2") 'Copy Project Name Sheets("Invoice data").Range("C" & i) = Sheets("Invoice").Range("C7") 'Copy Name Sheets("Invoice data").Range("D" & i) = Sheets("Invoice").Range("B" & a) 'Copy Hours Sheets("Invoice data").Range("E" & i) = Sheets("Invoice").Range("F" & a) 'Copy Cost Sheets("Invoice data").Range("F" & i) = Sheets("Invoice").Range("G" & a) 'Copy Total Sheets("Invoice data").Range("G" & i) = Sheets("Invoice").Range("H" & a) 'increase invoice data row i = i + 1 End If Next a 

我已经用input数据testing了代码。 它适合我。 尝试这个。

添加：

如果你想添加一个新的条件，修改if语句如下：

 If WorksheetFunction.CountA(Sheets("Invoice").Range("B" & a & ":G" & a)) <> 0 And Sheets("Invoice").Range("H" & a) > 0 Then