scan column for a variable and select the row - excel

Question

i have a big datasheet and i need a code to scan a column( screenshot "selection") for a x or add a checkbox. If there is a x the row should be selected and some of the columns should be transposed into a new table.
i have an code to scan the column for x and have the code to transpose the columns i need but i need some help to combine these codes together.
scan column(selection) for an x and select the rows
transpose some cells(selected colums) of the selected row into a new table ( i have the code)
For Each c In Range("K:K")
' If c.Value = "x" Then
' MsgBox "x found at " & c.Address
'End If
'Next c
Sub TransposeColumn2Row()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Myarray() As Variant
Dim LastRow As Integer, LastColumn As Integer
Dim StartCell As Range
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim i As Long
Dim j As Long
Set StartCell = ws1.Range("A1")
LastRow = ws1.Cells(ws1.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = ws1.Cells(StartCell.Row, ws1.Columns.Count).End(xlToLeft).Column
'copy specific columns into worksheet 2
j = 1
For i = 1 To LastColumn Step 1
Select Case i
Case 1, 4, 8, 6, 9, 3, 5 'target columns to copy
With ws1
Myarray() = .Range(.Cells(1, i), .Cells(LastRow, i)).Value
End With
With ws2
.Range(.Cells(j, 1), .Cells(j, LastRow)) = Application.WorksheetFunction.Transpose(Myarray())
End With
j = j + 1
Case Else
End Select
Next i
Erase Myarray()
End Sub
Help me combine these codes
Thx in advance

Answer 1

If this is a one-time task, I would use a formula:
=TRANSPOSE(FILTER(FILTER(A:J, {1,0,1,1,1,1,0,1,1,0}), K:K="x"))
The exact notation depends on local settings (the formula looks different in my case). But this one can be used with Evaluate in VBA. Here we mark columns to copy with an array {1,0,1,1,1,1,0,1,1,0} and then filter the rows with "x" in the column K.
As for VBA, this case would be easier to solve with ListObject in general case. But we can also Intersect columns of interest with marked rows and .Copy toDestination:
Sub CopyMarked()
Dim Source As Worksheet
Dim Destination As Worksheet
Dim Data As Range
Dim Criteria As Range
Set Source = ActiveSheet
Set Destination = Worksheets.Add(After:=Source)
Set Data = Source.Range("A:A, C:F, H:I") ' columns 1,4,8,6,9,3,5
Set Criteria = Source.Columns("K").SpecialCells(xlCellTypeConstants).EntireRow
Intersect(Data, Criteria).Copy
Destination.Range("a1").PasteSpecial xlPasteValues, Transpose:=True
End Sub