从一行写入多行

Excel + VBA。

我有一个4列ID，没有线轴，包装/交货长度的文件。 我正在做的是写基于没有线轴到另一个工作表的行数（你可以看到“CreateOrders”表中的数据更好地理解）。 这工作正常，但我有一个问题。 我之前在“截止date”工作表中：“CreateOrders”是把“今天的date”，但现在要根据上一页“PROGRAMA COBRE”中的ID放置一个特定的date，例如：

从：

至：

我的档案： http://speedy.sh/s4peR/Livro3.xlsm ： http://speedy.sh/s4peR/Livro3.xlsm

我手动，把所有的date“手”，但我怎么能自动做到这一点？

谢谢你的帮助。

编辑（我的代码）：

 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

这是你正在尝试（ 未经testing ）？ 改变你的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