Использование кода VBA для перемещения данных из накладной на страницу сводной информации о продажах

Question

Я создаю базу данных для моего друга. Она владеет небольшим магазином, где люди могут приобрести ремесленные изделия. Я создал список ремесленников и список инвентаря. на 2 листах у меня есть список счетов, который вызывает данные из списка инвентаря на основе кода товара (с помощью Vloolup), а также применяет двухбуквенную идентификацию Artisan. Затем у меня есть формула VBA, которая перемещает данные из каждого счета-фактуры в ведомость продаж, в которой хранятся данные о каждой продаже, даже после того, как счет был очищен. Это код, который я использую для переноса данных из каждого счета на лист "Продажи".

Я включил копию страницы счета-фактуры, чтобы вы могли видеть, откуда тянет мой код

КОД:

Sub SavingSalesData()
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 "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

КОНЕЦ КОДА:

Моя проблема в том, что когда я сохраняю каждый счет-фактуру, я получаю также все пустые строки в счете-фактуре:

Можно ли как-то изменить это, чтобы на листе "Продажи" отображались только те строки в счете-фактуре, которые используются?

Answer 1

Вместо использования всего диапазона счета, просто используйте часть, в которой вы знаете, что есть данные:

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