Ok, so I would really appreciate help as this has been driving me mad for over a week. 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.
Many thanks.
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.
VBA 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 SubMany thanks.
Last edited by a moderator:
