根據單元格值複製粘貼數據

Question

我有兩張紙：DataEntry和Datasheet。在C4和Number (Quantity of Data)上有DataEntry上的數據寫在E4上。我希望根據DataEntry E4上提及的次數在Datasheet上粘貼數據。

例如，數據上提到DataEntry是

C4 = Markers 
E4 = 5 

所以我想低於去年數據添加此標記在Datasheet粘貼在下一列與日期各行等其他項目的5倍的條目：

它是如何看起來像在DataSheet：

A2  B2 
Markers 01-Jan-14 
Markers 01-Jan-14 
Markers 01-Jan-14 
Markers 01-Jan-14 
Markers 01-Jan-14 

有人可以幫我用VBA代碼上面

Answer 1

試試這個：

Sub CopyBasedOnQuantity() 

    Dim DataEntry As Worksheet, DataSht As Worksheet 
    Dim ItemName As Range, ItemCount As Range 
    Dim NRow As Long, TargetCell As Range 

    With ThisWorkbook 
     Set DataEntry = .Sheets("DataEntry") 
     Set DataSht = .Sheets("Datasheet") 
    End With 

    With DataEntry 
     Set ItemName = .Range("C4") 
     Set ItemCount = .Range("E4") 
    End With 

    With DataSht 
     NRow = .Range("A" & Rows.Count).End(xlUp).Row + 1 
     Set TargetCell = .Range("A" & NRow) 
     TargetCell.Resize(ItemCount.Value, 1).Value = ItemName.Value 
     TargetCell.Offset(0, 1).Resize(ItemCount.Value, 1).Value = Date 
    End With 

End Sub 

截圖：

設置：

結果：

讓我們知道這是否有幫助。

Answer 2

這是我的版本，使用Worksheet Event。

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim entry As Range, count As Range, dest As Range 
Dim i As Integer, j As Integer 
Dim query As Integer 

On Error Goto errhandler 
Application.EnableEvents = False 

Set entry = ThisWorkbook.Sheets("DataEntry").Range("C4") 
Set count = ThisWorkbook.Sheets("DataEntry").Range("E4") 

Set dest = ThisWorkbook.Sheets("DataSheet").Range("A" & _ 
    Rows.count).End(xlUp).Offset(1, 0) 

If Not Intersect(Target, count) Is Nothing Then 
    query = MsgBox("Copy Data?", vbYesNo) 
    If query = 7 Then Exit Sub 
    i = Target.Value 
    For j = 1 To i 
     Target.Offset(0, -2).Copy dest 
     With dest.Offset(0, 1) 
      .Value = Date 
      .NumberFormat = "dd-mmm-yy" 
     End With 
     Set dest = ThisWorkbook.Sheets(2).Range("A" & _ 
      Rows.count).End(xlUp).Offset(1, 0) 
    Next 
End If 

continue: 
Application.EnableEvents = True 

Exit Sub 
errhandler: 
MsgBox Err.Description 
Resume continue 

End Sub 

希望這會有所幫助。
每當您更改E4數據贏取值C4將被複制到您的DataSheet。
Sheet中的代碼，而不是Module中的代碼。