Making adjacent cell blocks populate

Viewed 38

So I have a macro that populates 3 columns then duplicates that block of cells a specified number of times. I'd like to make the adjacent column populate 1 value up to the first adjacent blank and then populate the next value beside the next block. For instance, I want layer 1 to be beside the first block of cells, layer 2 beside the second block, down to the last block. if there's a way to not do this in excel, that works too. The specified number of layers is in block C62 on Test Ammo. Additionally, I just found that the number of copies the program makes depends on the amount of ammo specs with numbers in their qty column in TestAmmo for some reason so i'm trouble shooting that as well. (see picture).

Sub sortcopypastaPRT()
    Worksheets("PRT Endurance").Range("B6:D500").ClearContents
    
    Sheets("Test Ammo").Select
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=14, Criteria1:= _
        "<>"
    
    Sheets("Test Ammo").Range("N64:N113").Copy
    Sheets("PRT Endurance").Range("D6").PasteSpecial Paste:=xlPasteValues

    Sheets("Test Ammo").Range("O64:O113").Copy
    Sheets("PRT Endurance").Range("B6").PasteSpecial Paste:=xlPasteValues
    
    Sheets("Test Ammo").Range("C64:C113").Copy
    Sheets("PRT Endurance").Range("C6").PasteSpecial Paste:=xlPasteValues
       
 Sheets("PRT Endurance").Activate
    
        Dim rngSrc As Range
        Set rngSrc = Sheets("PRT Endurance").Range("B6", Range("D" & Rows.Count).End(xlUp))
        rngSrc.Copy
        
    Dim x As Long
    For x = 2 To Sheets("Test Ammo").Range("C62")
        Dim lr As Long
        lr = Range("B" & Rows.Count).End(xlUp).Row
        rngSrc.Offset((lr) - 4).PasteSpecial xlPasteValues
    Next x

    Sheets("PRT Endurance").Activate

    Range("B6:D500").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    MsgBox "Please select the respective layer values from the adjacent drop downs."
    
End Sub

^^ Here is the updated code, now if i can figure how to populate the A column with "layer 1" for the first chunk and "layer 2" for the second and so on.

enter image description here

0 Answers
Related