Excel VBA fufilling template с дополнительными строками

Question

Возможно, кто-нибудь знает, как выполнить такие действия в VBA: У меня есть шаблон на одном листе и на втором. Таблица выглядит следующим образом:

Unit Project Project Name Task Number Invoice Sum of Amount 
304  136950 Name1    02.3 invoice1 156.45 
304  136955 Name2    01.6 invoice1 22.35 

Итак, когда я заполняю шаблон, мне нужно проверить, если блок именование то же самое, и если да, то дополнительная строка должна быть создана в шаблоне.

В настоящее время у меня есть макрос, который выполняет шаблон только для одной строки отдельно, и проблема для меня в том, что если я создаю чек, все еще из-за «Для каждого ...», я сталкиваюсь с проблема с созданием нового листа вместо строки.

Поскольку я совершенно новый в VBA, есть возможность помочь мне в проблеме, так что, например, если Единица одинакова на линиях 1+ (порядок, заданный единицей, поэтому не будет ситуация, когда единица повторяется после нескольких строк ниже), вместо создания нового листа с заполненным шаблоном будет создана новая строка в шаблоне?

Macro я сейчас:

Set myRange = Range(Sheets("Data").Cells(2, 1), Sheets("Data").Cells(2, 1).End(xlDown)) 

i = 1 

For Each r In myRange.Cells 


Sheets("template").Select 
Sheets("template").Copy Before:=Sheets(1) 
Sheets("template (2)").Select 
Sheets("template (2)").Name = "Invoice " & i 
Range("C1:D1").Select 



ActiveSheet.Cells.Replace What:="{Unit}", Replacement:=r.Offset(0, 0), LookAt:=xlPart, _ 
          SearchOrder:=xlByRows, MatchCase:=False, _ 
          SearchFormat:=False, ReplaceFormat:=False 


ActiveSheet.Cells.Replace What:="{pr number}", Replacement:=r.Offset(0, 1), LookAt:=xlPart, _ 
          SearchOrder:=xlByRows, MatchCase:=False, _ 
          SearchFormat:=False, ReplaceFormat:=False 

ActiveSheet.Cells.Replace What:="{pr name}", Replacement:=r.Offset(0, 2), LookAt:=xlPart, _ 
          SearchOrder:=xlByRows, MatchCase:=False, _ 
          SearchFormat:=False, ReplaceFormat:=False 


ActiveSheet.Cells.Replace What:="{task nr}", Replacement:=r.Offset(0, 3), LookAt:=xlPart, _ 
          SearchOrder:=xlByRows, MatchCase:=False, _ 
          SearchFormat:=False, ReplaceFormat:=False 

ActiveSheet.Cells.Replace What:="{invoice number}", Replacement:=r.Offset(0, 4), LookAt:=xlPart, _ 
          SearchOrder:=xlByRows, MatchCase:=False, _ 
          SearchFormat:=False, ReplaceFormat:=False 

ActiveSheet.Cells.Replace What:="{amount}", Replacement:=r.Offset(0, 5), LookAt:=xlPart, _ 
          SearchOrder:=xlByRows, MatchCase:=False, _ 
          SearchFormat:=False, ReplaceFormat:=False 

i = i + 1 

    Next r 

Диапазоны, которые должны быть скопированы в виде новых линий, которые хранятся здесь:

Range("A24:H29").Select 'templated data, which should be copied if new row needed and then here I'm fulfilling info from table 
Selection.Copy 
Range("A31").Select 
ActiveSheet.Paste 
Application.CutCopyMode = False 
ActiveCell.FormulaR1C1 = j + 1 'line number 
Range("A33").Select 

Answer 1

Вы можете использовать For Loop. Сохраните одно уникальное имя устройства (например,), затем сравните последующие строки, если они совпадают. После того, как вы обнаружите несоответствие, вы знаете, что одна строка выше несоответствия, диапазон для сохраненных уникальных концов. Затем скопируйте этот диапазон на вновь созданный лист.

Sub CreateNewTemplates() 
    Dim wsTable As Worksheet 
    Dim wsNewTemplate As Worksheet 
    Dim rngStoredUnique As Range 

    Set wsTable = Worksheets("Table") 'worksheet where all the data is 
    With wsTable 
     For x = 1 To 50 'adjust to your needs 
      Set rngStoredUnique = .Cells(x, 1) 'adjust to your needs 
      Sheets("template").Copy after:=Sheets("template") 'adjust to your needs 
      Set wsNewTemplate = ActiveSheet 
      wsNewTemplate.Name = "Invoice " & rngStoredUnique.Value 'adjust to your needs 
      For y = 1 To 50 - x 'adjust to your needs 
       If rngStoredUnique <> rngStoredUnique.Offset(y, 0) Then 'check if the unit below is different than stored 
        Set rngToCopy = .Range(rngStoredUnique, rngStoredUnique.Offset(y - 1, 0)).Resize(ColumnSize:=10) 'adjust to your needs 
        x = x + y - 1 
        rngToCopy.Copy Destination:=wsNewTemplate.Cells(1, 1) 'adjust to your needs 
        If rngStoredUnique.Offset(y, 0) = "" Then Exit Sub 
        Exit For 
       End If 
      Next y 
     Next x 
    End With 
End Sub