![发票数据复制到另一张表,但不复制公式](https://linux22.com/image/1620415/%E5%8F%91%E7%A5%A8%E6%95%B0%E6%8D%AE%E5%A4%8D%E5%88%B6%E5%88%B0%E5%8F%A6%E4%B8%80%E5%BC%A0%E8%A1%A8%EF%BC%8C%E4%BD%86%E4%B8%8D%E5%A4%8D%E5%88%B6%E5%85%AC%E5%BC%8F.png)
我在这个网站上看到很多问题,但不确定我的问题是否已经得到解答。我找到了一个宏,并让它满足了我的需求,除了一件事。当它将我的数据从 Sheet 1 复制到 Sheet 2 时,它会产生空白单元格。这是因为 Sheet1 上的空白单元格中有公式。我只想要填充了文本的行,而不是包含公式的行。
Sub Button2_Click()
Dim rng As Range
Dim i As Long
Dim a As Long
Dim rng_dest As Range
Application.ScreenUpdating = False
i = 1
Set rng_dest = Sheets("Invoice data").Range("C:J")
' 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 B16:I38 on sheet Invoice to Variant array
Set rng = Sheets("Invoice").Range("A16:H30")
' 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("G3").Value
'Copy Date
Sheets("Invoice data").Range("B" & i).Value = Sheets("Invoice").Range("F2").Value
'Copy Customer name
Sheets("Invoice data").Range("k" & i).Value = Sheets("Invoice").Range("B8").Value
'Copy Customer Address
Sheets("Invoice data").Range("l" & i).Value = Sheets("Invoice").Range("B9").Value
'Copy Customer City,state
Sheets("Invoice data").Range("m" & i).Value = Sheets("Invoice").Range("B10").Value
'Copy Customer Phone
Sheets("Invoice data").Range("n" & i).Value = Sheets("Invoice").Range("B11").Value
'Copy Customer Email
Sheets("Invoice data").Range("o" & i).Value = Sheets("Invoice").Range("B12").Value
i = i + 1
End If
Next a
Application.ScreenUpdating = True
End Sub
答案1
如果我正确理解了您的问题,只需为源值添加一个额外的条件“If”,如下面的代码,即可解决问题。如果此方法无效,请告诉我,以便我们一起研究其他解决方案。
Sub Button2_Click()
Dim rng As Range
Dim i As Long
Dim a As Long
Dim rng_dest As Range
Application.ScreenUpdating = False
i = 1
Set rng_dest = Sheets("Invoice data").Range("C:J")
' 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 B16:I38 on sheet Invoice to Variant array
Set rng = Sheets("Invoice").Range("A16:H30")
' Copy rows containing values to sheet Invoice data
For a = 1 To rng.Rows.Count
If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
If rng.Rows(a).FormulaR1C1 <> "" then
rng_dest.Rows(i).Value = rng.Rows(a).Value
'Copy Invoice number
Sheets("Invoice data").Range("A" & i).Value = Sheets("Invoice").Range("G3").Value
'Copy Date
Sheets("Invoice data").Range("B" & i).Value = Sheets("Invoice").Range("F2").Value
'Copy Customer name
Sheets("Invoice data").Range("k" & i).Value = Sheets("Invoice").Range("B8").Value
'Copy Customer Address
Sheets("Invoice data").Range("l" & i).Value = Sheets("Invoice").Range("B9").Value
'Copy Customer City,state
Sheets("Invoice data").Range("m" & i).Value = Sheets("Invoice").Range("B10").Value
'Copy Customer Phone
Sheets("Invoice data").Range("n" & i).Value = Sheets("Invoice").Range("B11").Value
'Copy Customer Email
Sheets("Invoice data").Range("o" & i).Value = Sheets("Invoice").Range("B12").Value
i = i + 1
End If
End If
Next a
Application.ScreenUpdating = True
End Sub