Usando o código VBA para mover dados de uma fatura para uma página de resumo de vendas

Question

Estou criando um banco de dados para um amigo meu. Ela é proprietária de uma pequena loja onde as pessoas podem comprar peças artesanais. Eu criei uma lista de artesãos e uma lista de inventário. em 2 folhas então eu tenho uma lista de faturas que chama dados da lista de inventário com base em um código de item (usando o Vloolup) e também aplica a identificação de 2 letras do Artisan. Depois, tenho uma fórmula de VBA que move os dados de cada fatura para uma planilha de vendas que armazena os dados de cada venda, mesmo depois que a fatura é liberada. Este é o código que estou usando para transferir os dados de cada fatura para a planilha "Vendas".

Incluí uma cópia da página da fatura para que você possa ver onde meu código está sendo extraído

CÓDIGO:

SubSavingSalesData()DimrngAsRangeDimiAsLongDimaAsLongDimrng_destAsRangeApplication.ScreenUpdating=False'Checkifinvoice#isfoundonsheet"Sales"
  i = 2
  Do Until Sheets("Sales").Range("C" & i).Value = ""
    If Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value Then
      'Ask overwrite invoice #?
      If MsgBox("Invoice Number Already Used- Do you want to copy over?", vbYesNo) = vbNo Then
        Exit Sub
      Else
        Exit Do
      End If
    End If
    i = i + 1
  Loop
  i = 1
  Set rng_dest = Sheets("Sales").Range("F:K")
  'Delete rows if invoice # is found
  Do Until Sheets("Sales").Range("C" & i).Value = ""
    If Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value Then
      Sheets("Sales").Range("C" & i).EntireRow.Delete
      i = 1
    End If
    i = i + 2
  Loop
  ' Find first empty row in columns C:K on sheet Sales

    Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  'Copy range A8:E27 on sheet Invoice
  Set rng = Sheets("Invoice").Range("A7:F27")
  ' Copy rows containing values to sheet Sales
 For a = 2 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("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value
      'Copy Date
      Sheets("Sales").Range("D" & i).Value = Sheets("Invoice").Range("C3").Value
      'Copy Company name
      Sheets("Sales").Range("E" & i).Value = Sheets("Invoice").Range("C5").Value
      i = i + 1
    End If
  Next a
  Application.ScreenUpdating = True
End Sub

FIM DO CÓDIGO:

Meu problema é que, quando salvo cada fatura, todas as linhas em branco da fatura também são exibidas:

Existealgumamaneiradealterarissoparaqueapenasaslinhasdafaturausadassejamexibidasnaplanilha"Vendas"?

    

Answer 1

Em vez de usar todo o intervalo da fatura, basta usar a parte que você sabe que possui dados:

With Sheets("Invoice")
    Dim lastRow as Long
    Dim rng as Range
    lastRow = .cells(.rows.count, 1).end(xlup).row
    Set rng = .Range(.Cells(8, 1), .Cells(lastRow, 6))
End With

    

Answer 2

Sub Luu_HoaDon()
Dim rng As Range
  Dim i As Long
  Dim a As Long

  Dim rng_dest As Range
  Application.ScreenUpdating = False
  'Kiêm tra só Hóa don có trong sheet "Sales"
  i = 2
  Do Until Sheets("Sales").Range("C" & i).Value = ""
    If Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value Then
      'Hoi truóc khi ghi dè só Hóa don?
      If MsgBox("Trùng só Hóa don, Ban có ghi dè không?", vbYesNo) = vbNo Then
        Exit Sub
      Else
        Exit Do
      End If
    End If
    i = i + 1
  Loop
  i = 1
  Set rng_dest = Sheets("Sales").Range("F:K")
  'Ghi dè néu trùng só Hóa don
  Do Until Sheets("Sales").Range("C" & i).Value = ""
    If Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value Then
      Sheets("Sales").Range("C" & i).EntireRow.Delete
      i = 1
    End If
'    i = i + 2 '(chõ này nó cách 1 dòng tróng
    i = i + 1 'Thay 2 = 1 nó hét 1 dòng tróng
  Loop
  'Tìm dòng tróng côt C:K cua sheet Sales de ghi

    Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  '///////////////
  'Copy range A8:E27 on sheet Invoice
'  Set rng = Sheets("Invoice").Range("A7:F27")  'Thay dòng này bàng 5 dòng ké tiép

    With Sheets("Invoice")
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rng = .Range(.Cells(7, 1), .Cells(lastRow, 6))
    End With
'/////////////
  ' Copy Value tù Hóa don vào sheet Sales
 For a = 2 To rng.Rows.Count

    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
      rng_dest.Rows(i).Value = rng.Rows(a).Value
      'Copy só Hóa don
      Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value
      'Copy Date
      Sheets("Sales").Range("D" & i).Value = Sheets("Invoice").Range("C3").Value
      'Copy Company name
      Sheets("Sales").Range("E" & i).Value = Sheets("Invoice").Range("C5").Value
      i = i + 1
    End If
  Next a
  Application.ScreenUpdating = True
End Sub