Try this...
Sub copy()
Dim i As Integer
Dim j As Integer
Dim k As Integer
i = 1
k = 1
'check the end of the loop
Do While ThisWorkbook.Sheets(1).Range(Cells(i, 1), Cells(i, 1)).Value
<> ""
'copies the range
ThisWorkbook.Sheets(1).Range(Cells(i, 1), Cells(i, 2)).copy
'activates the sheet where the data will be copied
ThisWorkbook.Sheets(2).Activate
'selects the cells to paste
ThisWorkbook.Sheets(2).Cells(k, 1).Select
'paste the data
Selection.PasteSpecial
'loop count
k = k + 1
ThisWorkbook.Sheets(2).Cells(k, 1).Select
Selection.PasteSpecial
k = k + 1
ThisWorkbook.Sheets(2).Cells(k, 1).Select
Selection.PasteSpecial
k = k + 1
i = i + 1
ThisWorkbook.Sheets(1).Activate
Loop
End Sub
On Jun 16, 2:37 am, Amy <amymhe...@gmail.com> wrote:
> I have the Macro below and I think I need to add a loop to it. I want
> the Macro to take a worksheet of 206 rows and for it to copy each row
> and then insert say 3 identical lines between each row that contains
> the same information from the cells above it. I need to perform a task
> weekly and so the number of rows I need to copy may change from week
> to week, but I will always start out with 206 rows. For example if you
> just take what may be in Col. A only:
> Jan.
> Feb.
> Mar.
> April
> That is what I start out with. And if I request 3 copies of each row I
> want to end up with:
> Jan.
> Jan.
> Jan.
> Jan.
> Feb.
> Feb.
> Feb.
> Feb.
> Mar.
> Mar.
> Mar.
> Mar.
> April
> April
> April
> April
> If anyone could help me loop this or create a better macro I'd
> appreciate it. I do like that the dialog box comes up. Thanks! Macro
> is posted below:
>
> Sub CopyAndPaste()
>
> Dim Quantity As Integer
> Dim NoQuantity$
>
> NoQuantity$ = InputBox("The cursor must be placed anywhere on the row
> you want to copy. The pasted rows will appear directly beneath the
> copied row." + Chr$(13) + "" + Chr$(13) + "Enter the number of times
> to paste the copied row:", "Copy and Paste")
> If NoQuantity$ = "" Then
> GoTo Bye
> Else
> Quantity = Val(NoQuantity$)
> End If
>
> On Error Resume Next
> If Quantity <= 0 Then
> MsgBox "Invalid number entered.", vbCritical, "Stop!"
> Exit Sub
> End If
>
> For Row = Quantity To 1 Step -1
> ActiveCell.Offset(1, 0).EntireRow.Insert
> ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
> Next
>
> Bye:
> End Sub
--~--~---------~--~----~------------~-------~--~----~
-------------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
-------------------------------------------------------------------------------------
-~----------~----~----~----~------~----~------~--~---
