I have a sheet that logs blocks of ammunition for endurance testing which is done in layers. The number of ammo specs per layer isn't always the same so I have it set up as a dynamic range and a VBA code to pull those values (posted below). Additionally, I want to fill column A with "Layer 1" next to the first block of ammo specs, "Layer 2" next to the second block, and so on. The number of layers is called from C62 in the Test Ammo sheet, as are the individual ammo specs. You can see on the "Test Ammo" sheet where I specify that I want 10 layers and you can see how the data is laid out. The code for the endurance sheet goes in and sorts the table by eliminating blanks in the qty values. Is there an easy way to write in a code that fills the A column with the respective layers by the blocks of ammo for each layer?
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
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
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
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