Excel не правильно передает данные с одного листа на другой

Question

Недавно я работал над электронной таблицей, которая позволяет пользователям вводить данные на странице шаблона счета, а затем сохранять эту информацию на другом листе. Шаблон счета выглядит так:

Я просто поместил случайные входы для каждой ячейки. Затем данные из B17: H37 необходимо перенести на лист с именем Invoice, когда пользователь нажал кнопку «Сохранить». Данные должны быть введены в D: G на странице данных счетов-фактур, но результат, как, например:

А: С заполняются с различными значениями за пределами B17: H37 (как показано в коде ниже) , , но только данные «Название» (столбец B) из окна «Счет» копируются в лист данных счета, а «Часы», «Стоимость» и «Всего» - пренебречь. Вот код, который я до сих пор (из учебника я нашел в Интернете):

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, так что я совершенно запутался. Я попробовал функцию отладки, и здесь код обычно завинчивается: For a = 1 To rng.Rows.Count If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then rng_dest.Rows(i).Value = rng.Rows(a).Value. Если бы вы могли помочь мне исправить эту проблему, я был бы очень признателен :)

Кроме того, в качестве побочного примечания есть способ сделать так, чтобы строки с «0» в «Итого» (столбец H) не переносятся на страницу данных счета? Спасибо за ваше время.

На этом изображении я хочу, чтобы все из строки 7 и ниже было удалено, потому что я не вводил ничего на странице счета для этих строк.

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 

Я уже тестировал код с входными данными. Это хорошо работает для меня. Попробуй это.

Добавлено:

Если вы хотите добавить новое условие, изменить if заявление следующим образом:

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