Напишите несколько строк из одной строки

Question

Excel + VBA.

У меня есть файл с 4 столбцами ID, No Spools, Packing/Delivery Lenght. Что я делаю, это написать количество строк на основе No Spools на другом листе (вы можете увидеть данные в листе «CreateOrders», чтобы лучше понять). Это работает правильно, но у меня есть проблема. Я прежде в листе «Дата погашения»: «CreateOrders» помещал «Today Date», но теперь хочу указать конкретную дату в зависимости от идентификатора, который находится на предыдущем листе «PROGRAMA COBRE», например:

От:

To:

Мой Файл: http://speedy.sh/s4peR/Livro3.xlsm

Я сделал вручную, поместил все даты «вручную», но как я могу сделать это автоматически?

Благодарим за помощь.

EDIT (мой код):

Sub CreateOrdersFile() 
    Dim c As Range, a As Long, No_Order As String, sh2 As Worksheet 

    Set sh2 = Sheets("CreateOrders") 
    No_Order = Application.InputBox(Prompt:="Please enter the first Order Number (Today Date + 001)", Title:="Order Number required!") 

    With sh2 
     .UsedRange.ClearContents 
     .Range("A1:J1").Value = Array("No Order", "Due Date", "ID", "No Spools", "Packing Unit", "Quantity Unit", "Type", "Remark", "Storage Location", "Item No") 
     .Range("A2").Value = No_Order 
    End With 

    For Each c In Range("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row) 
     a = c.Value 

     With sh2.Cells(Rows.Count, 3).End(xlUp).Offset(1).Resize(a, 3) 
      .Value = Array(c.Offset(, -1).Value, 1, c.Offset(, 1).Value) 
     End With 

    Next c 
     With sh2 
      .Range("A2").AutoFill Destination:=.Range("A2:A" & .Cells(Rows.Count, 3).End(xlUp).Row), Type:=xlFillSeries 
       With .Range("B2:B" & .Cells(.Rows.Count, 3).End(xlUp).Row) 
        '.Value = Format(Date, "dd/mm/yyyy") 
        .Offset(, 4).Value = "M" 
        .Offset(, 5).Value = "Order" 
        .Offset(, 7).Value = "POGU01" 
        .Offset(, 8).Value = 1 
       End With 
     End With 
    MsgBox "Orders successfully created!", , "Orders Created" 
End Sub 

Answer 1

Это то, что вы пытаетесь (UNTESTED)? Измените ваши For loop этому

For Each c In Range("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row) 
    a = c.Value 

    With sh2.Cells(Rows.Count, 3).End(xlUp).Offset(1).Resize(a, 3) 
     .Value = Array(c.Offset(, -1).Value, 1, c.Offset(, 1).Value) 
    End With 

    '~~> The below "should" fill the Column B with Dates. 
    With sh2.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(a, 1) 
     .Value = c.Offset(, 2).Value 
    End With 
Next c