VBA copy worksheets and cells

[JERUMS]

I want to write a code that will copy a worksheet (Sheet2) x number of times and copy a differebt row of data from Sheet1 to each new copy.

For example: If I have data in rows 2 - 4 of Sheet1 I would want to copy Sheet2 three times and copy row 2 (Sheet1) to the first copy, copy row 3 (sheet1) to the second copy, and row 4 to the third copy.

The code i have to copy the sheets is below. But i don't know how to add the copy row feature.

Private Sub CommandButton1_Click()
    Dim x As Integer
     
    x = Range("A1").Value
    For numtimes = 1 To x
        'Loop by using x as the index number to make x number copies.
        'Replace "Sheet1" with the name of the sheet to be copied.
        ActiveWorkbook.Sheets("Sheet2").Copy _
           After:=ActiveWorkbook.Sheets("Sheet2")
         
    Next
    
End Sub

Any help you could give you be appreciated. I can change what I have if there is a better way. I am very new to this, but I really want to learn how to use VBA.

Thanks,

 

[pboltonchina]

Does this do what you want? Try on a copy of your data and change the sheet name (Parts Breakdown) to your sheet name.

Option Explicit

Sub CreateSheetPerLine()
'
' Macro1 Macro
'

'
   Application.ScreenUpdating = False
   Dim LR As Long, i As Long
LR = Range("A" & Rows.count).End(xlUp).Row
Sheets("Parts Breakdown").Select
For i = 2 To LR Step 1
    If Range("A" & i).Value <> "" Then Rows(i).Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.count)
    With ActiveSheet
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.CutCopyMode = False
    ActiveSheet.Name = Range("A1")
    Columns("A:A").AutoFit
    Cells(Rows.count, "A").End(xlUp).Offset(1).Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A1").Select
    End With
    Sheets("Parts Breakdown").Select
    Next i
    Application.ScreenUpdating = True
End Sub

 

[JERUMS]

Thank you pboltonchina.

That definately gets me on the right track. It seems that the code is just creating new sheets, not copying a sheet. Is this the case?

any clue on how to get it to copy a sheet instead? If not I can probably play around with it and see what I can get it to do.

Thank you!

 

[pboltonchina]

It creates a sheet for each individual value and then puts all the values together in that sheet. If you want to copy the main sheet and then leave the cheapest supplier and delete the rest maybe you would be better going down the Autofilter route. I dont know what the difference in results would be as you haven't posted a sample of your data

 

[JERUMS]

I am sorry I haven't gotten back to you in a while, I have been busy with a bunch of other projects. I am still having trouble with this. If I can send you my excel file so you can see what exactly I am trying to do would it help? How would I do that? Would I message it to you?