Find a row based on a cell value, copy only part of the row in to a new sheet and the rest of the row into the next row of the new sheet - excel

Question

I have a file that has 5 transaction codes ("IPL","ISL","IMO","IIC","CAPO").
I need my macro to find the first 4 transaction codes in column dc of worksheets("sort area"), if it locates it, then take the contents of DE-FN and copy values to a new sheet.
for the last transaction code, i need the macro to find the transaction code in dc, and if it's there take the contents of the row but only the subsequent 8 columns (DE-DL) copy paste values in to worksheet("flat file") and then take the next 8 columns (DM-DS) from the original sheet ("sort area") and copy values in worksheet("flat file") but the following row
for the first part of the macro, i have it separated in to two parts, where i am copying the contents of the entire row, pasting values in to a new sheet, and then sorting the contents and deleting unneeded columns in the new sheet.
I'm struggling because my code is skipping some rows that contain IPL and i don't know why.
i have no idea how to do the last part, CAPO.
Part A (this takes the IPL transaction code and moves it to the new sheet ("flat file"):
Sub IPLFlat()
Dim xRg As Range
Dim xCell As Range
Dim xRRg1 As Range
Dim xRRg2 As Range
Dim I As Long
Dim J As Long
Dim K As Long
Dim xC1 As Long
Dim xFNum As Long
Dim xDShName As String
Dim xRShName As String
xDShName = "sort area"
xRShName = "flat file"
I = Worksheets(xDShName).UsedRange.Rows.Count
J = Worksheets(xRShName).UsedRange.Rows.Count
xC1 = Worksheets(xDShName).UsedRange.Columns.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets(xRShName).UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets(xDShName).Range("DC2:DC" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "IPL" Then
Set xRRg1 = xRg(K).EntireRow
Set xRRg2 = Worksheets(xRShName).Range("A" & J + 1).EntireRow
xRRg2.Value = xRRg1.Value
If CStr(xRg(K).Value) = "IPL" Then
K = K + 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
'Sort Flatfile tab
Worksheets("flat file").Activate
With ActiveSheet.Sort
.SortFields.Add Key:=Range("DF1"), Order:=xlAscending
.SetRange Range("A1", Range("FG" & Rows.Count).End(xlUp))
.Header = xlNo
.Apply
End With
Columns("A:DD").EntireColumn.Delete

Answer 1

Here is a solution:
Sub stackOverflow()
Dim sortSheet As Worksheet, flatSheet As Worksheet, newSheet As Worksheet
Set sortSheet = ThisWorkbook.Sheets("sort area")
Set flatSheet = ThisWorkbook.Sheets("flat file")
Dim rCount As Long, fCount As Long
rCount = sortSheet.Cells(sortSheet.Rows.Count, 1).End(xlUp).Row
For i = 2 To rCount
Select Case sortSheet.Cells(i, 107).Value
Case "IPL", "ISL", "IMO", "IIC"
Set newSheet = ThisWorkbook.Sheets.Add
sortSheet.Range(sortSheet.Cells(i, 109), sortSheet.Cells(i, 170)).Copy 'de->109 fn->170
newSheet.Paste
Case "CAPO"
With flatSheet
fCount = .Cells(.Rows.Count, 1).End(xlUp).Row
sortSheet.Range(sortSheet.Cells(i, 109), sortSheet.Cells(i, 116)).Copy 'de->109 dl->116
.Range(.Cells((fCount + 1), 1), .Cells((fCount + 1), 8).PasteSpecial Paste:xlPasteValues
sortSheet.Range(sortSheet.Cells(i, 117), sortSheet.Cells(i, 123)).Copy 'dm->117 ds->123
.Range(.Cells((fCount + 2), 1), .Cells((fCount + 2), 6).PasteSpecial Paste:xlPasteValues
End With
End Select
Next i
End Sub
I hope I understood your problem correctly and that this helps,
Cheers