Copy & Paste Multiples

[tnemom]

I have a worksheet that I have users enter data, and then that data is transfered to another sheet - so that the format can be used to create other things.

They enter the following data: Item, Type, Voltage, Activity and Quantity.

Right now I have the following code

Sub senddata()
Worksheets("QuesLinks").Select
 Range("A1:E1").Select
Application.CutCopyMode = False
Selection.Copy
Worksheets("Estimate List").Select
Dim LastCell As Range
With ActiveSheet
    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    If IsEmpty(LastCell) Then
         'do nothing
    Else
        Set LastCell = LastCell.Offset(1, 0)
        LastCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
End With


End Sub

What I was wondering is if the code can be altered so that based upon the quantity entered, data would be copied over in multiples.

If the quantity is one - the line is pasted once
If the quantity is two - the line is pasted twice...and so on.

Thanks
TNEMOM

 

[venkat1926]

you have not said the number in which column should be taken into consideration for repeated copying. I assumed it is in column A. I have given headings as the first row.

if the relevant column is not column A you have to slightly modify the line
set col A=..............

run this macro and see sheet 2 whether you get what you want.

Sub test()


Dim colA As Range, c As Range
Dim dest As Range
Dim i As Integer, j As Integer
With Worksheets("sheet1")
Set colA = Range([a2], [a2].End(xlDown))
For Each c In colA
j = c
MsgBox j
Range(c, c.End(xlToRight)).Copy

With Worksheets("sheet2")
For i = 1 To j
Set dest = .Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
dest.PasteSpecial
Next i
End With
Next c
End With
application.cutcopymode=false
MsgBox "macro over"
End Sub

 

[Peter_SSs]

tnemom

I am not certain that I have understood your requirements correctly, but give this a try. If it doesn't do what you want, explain in what way it fails and try to provide further details.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> senddata()
    <SPAN style="color:#00007F">Dim</SPAN> wsQL <SPAN style="color:#00007F">As</SPAN> Worksheet
    <SPAN style="color:#00007F">Dim</SPAN> wsEL <SPAN style="color:#00007F">As</SPAN> Worksheet
    <SPAN style="color:#00007F">Dim</SPAN> lrQL <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> crEL <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> Multiple <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    
    <SPAN style="color:#00007F">Set</SPAN> wsQL = Worksheets("QuesLinks")
    <SPAN style="color:#00007F">Set</SPAN> wsEL = Worksheets("Estimate List")
    wsEL.Range("A1:E1").Value = wsQL.Range("A1:E1").Value
    lrQL = wsQL.Range("A" & Rows.Count).End(xlUp).Row
    crEL = 2
    <SPAN style="color:#00007F">For</SPAN> r = 2 <SPAN style="color:#00007F">To</SPAN> lrQL
        Multiple = wsQL.Cells(r, 5).Value
        wsQL.Range("A" & r).Resize(, 5).Copy _
            Destination:=wsEL.Range("A" & crEL).Resize(Multiple)
        crEL = crEL + Multiple
    <SPAN style="color:#00007F">Next</SPAN> r
    Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[tnemom]

Here are screen shots of what I am trying to achieve.

This page is a list of questions the user will answer

senddata.xls
	A	B	C	D
1	Whatitemwouldyouliketoaddfirst?
2	Breaker
3
4	WhatType?
5	Oil
6
7	Whatvoltage?
8	44KV
9
10	WhatActivity?
11	Remove/Replace
12
13	Quantity?
14	2
Questions

These answers then get transfered to the "links" page

senddata.xls
	A	B	C	D	E
1	Breaker	Oil	44KV	Remove/Replace	2
QuesLinks

Then the page that these links go to is the "Estimate List"

senddata.xls
	A	B	C	D	E	F
1	What	Type	Voltafe	Action		Code
2	Breaker	Oil	44KV	Remove/Replace		BR-O-44-RR
3	Breaker	Oil	44KV	Remove/Replace		BR-O-44-RR
Estimate List

Basically what I was trying to explain before was that when the user inputs the quantity of items they would like to perform work on, this quantity is then copied over to the "Estimate List" as per the examples presented.

They would like to Remove/Replace 2 44Kv Oil Breakers - so this line is then repeated twice on the Estimate List. If the quantity is 1 - then it is only copied once, quantity is 3 - then copied three times...and so on. The users then continue building the list for jobs to do in the estimate.

This Estimate List is then used to generate an estimate based on the information in it.

Hopefully I have cleared things up. I have tried the two code samples that were given, unfortunately due to my "clear as mud" explanation, they don't do what I wanted.

Thanks,
TNEMOM

 

[Peter_SSs]

OK, got a bit clearer idea now. Try the code below, noting that it does assume headings already appear in sheets "QuesLinks" and "Estimate List". I note that you don't have headings in "QuesLinks" but am guessing that you could put them in. If not ,and the code does not do what you want, post back.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> senddata()
    <SPAN style="color:#00007F">Dim</SPAN> wsQ <SPAN style="color:#00007F">As</SPAN> Worksheet
    <SPAN style="color:#00007F">Dim</SPAN> wsQL <SPAN style="color:#00007F">As</SPAN> Worksheet
    <SPAN style="color:#00007F">Dim</SPAN> wsEL <SPAN style="color:#00007F">As</SPAN> Worksheet
    <SPAN style="color:#00007F">Dim</SPAN> NextRowQL <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> NextRowEL <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> Multiple <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    
    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> wsQ = Worksheets("Questions")
    <SPAN style="color:#00007F">Set</SPAN> wsQL = Worksheets("QuesLinks")
    <SPAN style="color:#00007F">Set</SPAN> wsEL = Worksheets("Estimate List")
    NextRowQL = wsQL.Cells(Rows.Count, 1).End(xlUp).Row + 1
    NextRowEL = wsEL.Cells(Rows.Count, 1).End(xlUp).Row + 1
    <SPAN style="color:#00007F">For</SPAN> r = 1 <SPAN style="color:#00007F">To</SPAN> 5
        wsQL.Cells(NextRowQL, r).Value = wsQ.Cells(3 * r - 1, 1).Value
    <SPAN style="color:#00007F">Next</SPAN> r
    Multiple = wsQ.Cells(14, 1).Value
    wsQL.Cells(NextRowQL, 1).Resize(, 4).Copy _
            Destination:=wsEL.Cells(NextRowEL, 1).Resize(Multiple)
    Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN>
    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[tnemom]

Code works great!!!

Thank you for all your help!!

TNEMOM