简体   繁体   中英

Using VBA to Add Rows based on a cell value onto another worksheet

I am trying to create a spreadsheet whereby I have a value in a cell in a worksheet called "Equipment" cell C5, for example a Value of 4.

Starting Cell Image

I need to use this value to copy a section of the same row (D5:M5) and paste it that many times into a worksheet called "Programming" also if this changes I would like it to delete or add where required, ignoring where there is a blank or 0 value in the "equipment" sheet

Desired Result

I have around 30 different items and all will have different sections to copy but they will be of the same size. Also Could this look down a list of values all in the same column and do the same for all the values

I'm very new to VBA and have managed to hide and show tabs based on values but i'm struggling to get my head around this as it's a little too complicated at this point.

Thank You in advance

Lee

This is what I have so far, I have edited the code to what I believe is correct but it still isn't working

Sub copySheetCells()

'loop by each cell in column "C"
For i = 2 To Sheets("Equipment").Cells(Rows.Count, "C").End(xlUp).Row
    'repeat copy x times (based on cell in column "C" value)
    For j = 0 To (Sheets("Equipment").Cells(i, "C").Value - 1)
        'define source range
        Source = "D" & (i) & ":M" & (i)
        'find last row on second sheet
        lastRowS2 = Sheets("Hardware_Programming").Cells(Rows.Count, "A").End(xlUp).Row
        'copy data
    Sheets("Equipment").Range(Source).copy Destination:=Sheets("Hardware_Programming").Range("A" & lastRowS2 + 1)
Next j
Next i
'copy headers
Sheets("Equipment").Range("D1:M1").copy Destination:=Sheets    ("Hardware_Programming").Range("A1:J1")
End Sub

I only get blank spaces, is anyone able to advise any further?

Here you go, use this macro. Based on names Programming and Equipment as originally requested.

Sub copySheetCells()
'loop by each cell in column "C"
For i = 2 To Sheets("Programming").Cells(Rows.Count, "C").End(xlUp).Row
    'repeat copy x times (based on cell in column "C" value)
    For j = 0 To (Sheets("Programming").Cells(i, "C").Value - 1)
        'define source range
        Source = "D" & (i) & ":M" & (i)
        'find last row on second sheet
        lastRowS2 = Sheets("Equipment").Cells(Rows.Count, "A").End(xlUp).Row
        'copy data
        Sheets("Programming").Range(Source).copy Destination:=Sheets("Equipment").Range("A" & lastRowS2 + 1)
    Next j
Next i
'copy headers
Sheets("Programming").Range("D1:M1").copy Destination:=Sheets("Equipment").Range("A1:J1")
End Sub

EDIT

Please avoid copying the code from the answer and posting it back at your question, I replaced the Sheet1 with Programming so you can rename that sheet in your workbook.

Macro seems to do what it does, the quantity in Sheet1/Programming was not provided (column "C" according to your initial requirements):

Source (with added quantity) 资源

Result: 在此处输入图片说明

Hope this will solve your problem :)

    For i = 1 To 30 Step 1
            If Sheets("Equipment").Cells(1 + 4, 3).Value > 0 Then
            Sheet1.Range(Cells(i + 3, 5), Cells(i + 3, 13)).Copy
                For j = 1 To Sheet1.Cells(1 + 4, 3).Value Step 1
                LR = Sheets("Programming").Cells(Sheets("Programming").Rows.Count, "A").End(xlUp).Row
                    Sheets("Programming").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues

                Next
            End If
Next

Cheers ;)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM