VBA - conditional copying different column ranges

Ok, so I would really appreciate help. Basically I have a raw data table where a customer can choose up to 3 different courses, data is in 3 columns. But I need to be able to have a complete table where if a customer selects 3 courses, her details appear in 3 different rows. The paste destination is always the same, but the copy range is slightly different. I have got the code to duplicate rows for more than 1 selection, but I can't get it to copy the selected columns as opposed to the whole row. I have tried defining selection ranges with each if statement and arrays but I am at a complete loss so any advice would save me sanity. Code so far (such that it is, is below) - I had to use paste special values as there are formulae in the original table picking up from another spreadsheet, which I dont want in the final version.

Code:

---

Private Sub CommandButton1_Click()
ScreenUpdating = False
Dim modules As Range
  Dim wb As Range
  Dim arom As Range
  Dim med As Range
Dim Source As Worksheet
    Dim Target As Worksheet
Set Source = ActiveWorkbook.Worksheets("Raw Table")
 Set Target = ActiveWorkbook.Worksheets("Finished Table")
' Start copying to row 4 in target sheet
    j = 4
For Each wb In Source.Range("K4:K1000")
If wb = "Well being course" Then
      Source.Rows(cwb.Row).Copy
      ' to only copy A:E,K:L,S:U
Target.Rows(j).PasteSpecial Paste:=xlPasteValues
          'to paste into Cols A:J
j = j + 1
        End If
            Next wb
 For Each arom In Source.Range("M4:M100")    'Do 1000 rows
If arom = "Aromatherapy" Then
Source.Rows(arom.Row).Copy
        ' to only copy A:E, M:N, S:U
      Target.Rows(j).PasteSpecial Paste:=xlPasteValues
          'to paste into Cols A:J
            j = j + 1
  End If
      Next arom
For Each med In Source.Range("O4:O100")    'Do 1000 rows
If med = "Meditation" Then
Source.Rows(med.Row).Copy
          ' to only copy A:E, O:P, S:U
      Target.Rows(j).PasteSpecial Paste:=xlPasteValues
      'to paste into Cols A:J
j = j + 1
  End If
      Next med
ScreenUpdating = False
End Sub

---

Many thanks.

I Renamed all variables named after KeyWords and removed duplicates. Also, I hate overloading Event Subs, so I put the working code into its own Procedure.

Code:

---

Option Explicit

Private Sub CommandButton1_Click()
    MoveDataToFinishedTable
End Sub

Private Sub MoveDataToFinishedTable()
Dim Cel As Range
Dim Src As Worksheet
Dim Trgt As Worksheet
Dim Rw As Long
Dim Lr As Long

    Set Src = ActiveWorkbook.Worksheets("Raw Table")
    Set Trgt = ActiveWorkbook.Worksheets("Finished Table")
    With Src 'Find Required Rows
        Lr = WorksheetFunction.Max(.Cells(Rows.Count, "K").End(xlUp).Row, _
                .Cells(Rows.Count, "M").End(xlUp).Row, _
                .Cells(Rows.Count, "O").End(xlUp).Row)
   
    ' Start copying to row 4 in Trgt sheet
    Rw = 4

Application.ScreenUpdating = False

For Each Cel In .Range("K4:K" & Lr)    'Do Required rows
    If Cel = "Well being course" Then
      ' to only copy A:E,K:L,S:U
        .Rows(Cel.Row).Union(Range("A:E"), Range("K:L"), Range("S:U")).Copy
        Trgt.Cells(Rw, "A").PasteSpecial Paste:=xlPasteValues
          'to paste into Cols A:Rw
        Rw = Rw + 1
  End If
Next Cel

For Each Cel In .Range("M4:M" & Lr)    'Do Required rows
    If Cel = "Celatherapy" Then
        ' to only copy A:E, M:N, S:U
        .Rows(Cel.Row).Union(Range("A:E"), Range("M:N"), Range("S:U")).Copy
        Trgt.Cells(Rw, "A").PasteSpecial Paste:=xlPasteValues
        'to paste into Cols A:Rw
        Rw = Rw + 1
  End If
Next Cel

For Each Cel In .Range("O4:O" & Lr)  'Do Required rows
    If Cel = "Celitation" Then
      ' to only copy A:E, O:P, S:U
      .Rows(Cel.Row).Union(Range("A:E"), Range("O:P"), Range("S:U")).Copy
        Trgt.Cells(Rw, "A").PasteSpecial Paste:=xlPasteValues
        'to paste into Cols A:Rw
        Rw = Rw + 1
  End If
Next Cel

 End With 'Src

Application.ScreenUpdating = True
End Sub

---

Firstly apologies in delay in responding. Secondly huge thanks for the code, very appreciated!!! I’ve never actually seen the union coding in practice before and take your point about separate procedures, it is a nasty habit of mine ��