☰

发票数据复制到另一张表，但不复制公式

tag-icon • tag-icon microsoft-excel worksheet-function microsoft-excel-2010 vba macros
发票数据复制到另一张表，但不复制公式

我在这个网站上看到很多问题，但不确定我的问题是否已经得到解答。我找到了一个宏，并让它满足了我的需求，除了一件事。当它将我的数据从 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

相关内容