Solved: changing lines that transfer

[Scooter172]

The following code needs to be changed. This code was inherited so do not know what the writer was thinking.

I want to update a unshared book with this Macro. The code copies information from this book to another. for each Letter named line on the document it requires 2 rows of text. It originally had two rows of text and a blank/Free of data row between the second data row and the new lettered line below. We originally had three lettered lines/three rows each, and now want to have 6 lettered lines of 2 rows each with no blank lines between that transfer.






[VBA] 'Line 6
intI = 1
intJ = 1
Dim intK As Integer 'text index for swap warrant
Dim intL As Integer 'text index for active warrant
intK = 1
intL = 1
For Each C In ThisWorkbook.Sheets("LRV p1").[lrv1Line6Current]
If C = True Then
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6letter].Cells(intL, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK + 1, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL + 1, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK + 2, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL + 2, 1)
intJ = intJ + 1
intK = intK + 3
End If
intI = intI + 1
intL = intL + 3
Next C
If intK <= 7 Then 'fill in the rest of the letters skipping "l" and going to "a" after "Z" starting with nextLetter and continuing in order
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1nextLetter].Cells(6, 1)
intK = intK + 3
End If
Do While intK <= 7 'as is this Do Loop will run at most once. Programmed this way for consistency with other lines and to allow easier expansion if more line 6's are added
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK - 3, 1) + 1
If Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 108 Then
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 109
Else
If Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 123 Then Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intL, 1) = 97
End If
intK = intK + 3
Loop

Workbooks("OpsTableSwapFile.xlsx").Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub[/VBA]

[Scooter172]

This is the new layout of the new book

[Scooter172]

I got this solved by changing some of the numbers. Thanks for your advise.
Here is the result.

[VBA] 'Line 6
intI = 1
intJ = 1
Dim intK As Integer 'text index for swap warrant
Dim intL As Integer 'text index for active warrant
intK = 1
intL = 1
For Each C In ThisWorkbook.Sheets("LRV p1").[lrv1Line6Current]
If C = True Then
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6letter].Cells(intL, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK + 1, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL + 1, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK + 2, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL + 2, 1)
intJ = intJ + 1
intK = intK + 2
End If
intI = intI + 1
intL = intL + 2
Next C
If intK <= 11 Then 'fill in the rest of the letters skipping "l" and going to "a" after "Z" starting with nextLetter and continuing in order
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1nextLetter].Cells(6, 1)
intK = intK + 2
End If
Do While intK <= 11 'as is this Do Loop will run at most once. Programmed this way for consistency with other lines and to allow easier expansion if more line 6's are added
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK - 2, 1) + 1
If Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 108 Then
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 109
Else
If Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 123 Then Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intL, 1) = 97
End If
intK = intK + 2
Loop

Workbooks("OpsTableSwapFile.xlsx").Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub [/VBA]