CODEWITHSUNDEEP
vbaexcel
user3196669
user3196669

Reputation: 3

Copy-pasting data a number of times based on cell value

I have two sheets: DataEntry and Datasheet. There is data written on DataEntry on C4 and Number (Quantity of Data) on E4. I want data to be pasted on Datasheet based on number of times mentioned on DataEntry E4.

For Eg. Data Mentioned on DataEntry is

C4 = Markers
E4 = 5

So I want entry of this Markers 5 times pasted in Datasheet on respective rows with Date in next column and so on other items to be added below last data:

How it would look like in DataSheet:

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

Can somebody help me with VBA codes for above

Upvotes: 0

Views: 4338

Answers (2)

L42
L42

Reputation: 19737

This is my version using 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

Hope this helps.
Everytime you change value in E4 data win C4 will be copied to your DataSheet.
Code in Sheet, not in Module.

Upvotes: 1

WGS
WGS

Reputation: 14179

Try this:

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

Screenshots:

Set-up:

enter image description here

Result:

enter image description here

Let us know if this helps.

Upvotes: 0

Related Questions