CourtJester
New Member
- Joined
- Feb 4, 2021
- Messages
- 2
- Office Version
- 365
- Platform
- Windows
- MacOS
- Mobile
- Web
I've been driving myself crazy trying to figure this out.
Can someone please help?
The following is a generic list imported from an AutoCAD file and the WB-# stand for bundles represented in the second sheet:
The imported list will change based on the project but, the wire bundles stay the same.
I'm trying to insert the cells on the second sheet into the first, in place of the "WB-#"s to create a complete list.
For example:
I got as far as inserting new rows under the wire bundles but, can't figure out how to copy the info in.
Total noob here so don't judge me too harshly. I'm sure there's a simpler way to insert everything.
Can someone please help?
The following is a generic list imported from an AutoCAD file and the WB-# stand for bundles represented in the second sheet:
The imported list will change based on the project but, the wire bundles stay the same.
I'm trying to insert the cells on the second sheet into the first, in place of the "WB-#"s to create a complete list.
For example:
I got as far as inserting new rows under the wire bundles but, can't figure out how to copy the info in.
Total noob here so don't judge me too harshly. I'm sure there's a simpler way to insert everything.
VBA Code:
Sub InsertWireBundleRows()
Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Col = "C"
StartRow = 1
BlankRows = 1
LastRow = Cells(Rows.Count, Col).End(xlUp).Row
Application.ScreenUpdating = False
With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) = "WB-1" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
ElseIf .Cells(R, Col) = "WB-2" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
ElseIf .Cells(R, Col) = "WB-3" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
ElseIf .Cells(R, Col) = "WB-4" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
ElseIf .Cells(R, Col) = "WB-5" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
ElseIf .Cells(R, Col) = "WB-6F" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
ElseIf .Cells(R, Col) = "WB-7F" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
ElseIf .Cells(R, Col) = "WB-8F" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
ElseIf .Cells(R, Col) = "WB-TP" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
Application.ScreenUpdating = True
End Sub