0

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

ag17
  • 1
  • 1
  • You'll want to understand how to use a [for loop](https://excelmacromastery.com/vba-for-loop/). Also, you can greatly simplify your code by [avoiding `Select`](https://stackoverflow.com/a/10717999/4717755). – PeterT Sep 20 '22 at 19:57
  • To give an example of how to avoid `Select`: Instead of `Sheets("PRT Endurance").Select: Range("C6").Select: Selection.PasteSpecial ...` you can do `Sheets("PRT Endurance").Range("C6").PasteSpecial ...` turning 3 lines into 1! – Toddleson Sep 20 '22 at 20:12
  • Even better, you can do the same to the set of lines above that, and then combine the two using `Range1.Copy Destination:=Range2` like `Sheets("Test Ammo").Range("C64:C113").Copy Destination:=Sheets("PRT Endurance").Range("C6")` now thats 6 lines turned into 1. – Toddleson Sep 20 '22 at 20:14
  • Once you have your code in this format, it is easy to see how you can loop it. Simply exchange the hardcoded addresses for variable column and row number. Make the column number change based on the loop element, and you can suddenly re-use that 1 line over multiple sections. – Toddleson Sep 20 '22 at 20:18
  • The sheets.select.range.etc was what Excel wrote when i clicked record and manually went in and filtered the data and copied it over. I wasn't having much luck finding a way to code it to eliminate gaps in the data and i needed it to filter gaps out in the table. The only parts of the code that I wrote was the clearcontents line at the top and the dim rngsrc at the bottom . – ag17 Sep 21 '22 at 11:55

0 Answers0