Consulting

Results 1 to 3 of 3

Thread: VBA - conditional copying different column ranges

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Newbie
    Joined
    Apr 2021
    Posts
    2
    Location

    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.


    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.
    Last edited by Aussiebear; 04-04-2021 at 01:19 AM. Reason: Wrapped supplied code in tags

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •