Copy paste three different ranges in a userform

Question

I have two worksheets . L12 Database and Working Sheet . I have a userform which copies rows of data from any sheet to range A393 of the working sheet. However I realised that I only need to copy certain column data of that row instead of the entire row. It is split into 3 ranges , L12 Database should copy Columns A:D, I:J, and L:R. This copied data should paste into the Working Sheet Columns A:D,E:F and I:O . A previous suggestion was to do a loop through but it was only applicable to two ranges. Hence I would need some help on how I can copy and paste to three ranges in one userform. This was a code done by a stackoverflow user (Sorry I do not remember your name) which is what I roughly want to do. Thanks!

Private Sub CommandButton1_Click()
Dim rngCopy As Range, rngPaste As Range
Dim wsCopy As Worksheet, wsPaste As Worksheet
Dim LngCounter As Long

If RefEdit1.Value <> "" Then
    Set wsCopy = ThisWorkbook.Sheets(Replace(Split(RefEdit1.Value, "!")(0), "'", ""))
    Set wsPaste = ThisWorkbook.Sheets("Working Sheet")
    For LngCounter = 0 To 1
        If LngCounter = 0 Then
            Set rngCopy = wsCopy.Range(Split(RefEdit1.Value, "!")(1))
            Set rngPaste = wsPaste.Range("A401")
        Else
            Set rngCopy = wsCopy.Range(Replace(Replace(Split(RefEdit1.Value, "!")(1), "A", "I"), "D", "R"))
            Set rngPaste = wsPaste.Range("E401")
        End If

        If CheckBox1.Value = True Then
            wsPaste.Activate
            rngPaste.Select
            rngCopy.Copy
            ActiveSheet.Paste Link:=True
        Else
            rngCopy.Copy rngPaste
        End If

        Set rngPaste = Nothing
        Set rngCopy = Nothing

    Next
Else
    MsgBox "Please select Input range"
End If
End Sub

This was the userform code I did previously:

Private Sub CommandButton1_Click()
    Dim rngCopy As Range, rngPaste As Range
    Dim wsCopy As Worksheet, wsPaste As Worksheet

    If RefEdit1.Value <> "" Then
        Set wsCopy = ThisWorkbook.Sheets(Replace(Split(RefEdit1.Value, "!")(0), "'", "")) 'Sheet name of the data selected by user
        Set rngCopy = wsCopy.Range(Split(RefEdit1.Value, "!")(1)) 'Range of the data selected by user

        Set wsPaste = ThisWorkbook.Sheets("Working Sheet") 'Sheet location where data copied would be pasted
        Set rngPaste = wsPaste.Range("A393") 'Range Area where data copied would be pasted in columns A and B of database sheet

        If CheckBox1.Value = True Then
            wsPaste.Activate
            rngPaste.Select
            rngCopy.Copy
            ActiveSheet.Paste Link:=True 'Activate paste link between info sheet and database sheet
        Else
            rngCopy.Copy rngPaste
        End If
    Else
        MsgBox "Please select Input range" 'If user did not key in any input, this message wouldp pop up
    End If
End Sub   

Answer 1

edited : to fix "Solution A" Areas object handling. and added "rngPaste handling

I'll throw in two solutions

---

solution A

following your "scheme"

Option Explicit

Private Sub CommandButton1_Click()
    Dim rngCopy As Range, rngPaste As Range, rngSelected As Areas '<~~ rngSelected is to be of "Areas" type
    Dim wsCopy As Worksheet, wsPaste As Worksheet, wsActive As Worksheet

    If RefEdit1.Value <> "" Then

        Set rngSelected = Range(Replace(RefEdit1.Text, ";", ",")).Areas  '<~~ store the selected range. Note:I had to use this Rpelace since my country customizations has addresses returned by RefEdit control Text property separed by a ";" instead of a ","
        Set wsCopy = rngSelected.Parent.Parent '<~~ the parent property of Areas object returns a Range object, whose parent property eventually returns a worksheet object!
        Set wsPaste = ThisWorkbook.Sheets("Working Sheet")

        If Me.CheckBox1 Then '<~~ if requested...
            Set wsActive = ActiveSheet ''<~~ ... store active sheet for eventually returning to it...
            wsPaste.Select ''<~~  ... and activate "wsPaste" sheet once for all and avoid sheets jumping
        End If

        For Each rngCopy In rngSelected
            Set rngPaste = Nothing '<~~ initialize rngPaste to Nothing, so that it's possible to detect its possible setting to a range if any check of Select Case block is successful
            Select Case rngCopy.Columns.EntireColumn.Address(False, False) '<~~ check columns involved in each area
                Case "A:D" '<~~ if columns range A to D is involved, then...
                    Set rngPaste = wsPaste.Range("A401") '<~~ ... have it pasted form wsPaste cell A401 on
                Case "I:J" '<~~ if columns range I to J is involved, then...
                    Set rngPaste = wsPaste.Range("E401") '<~~ ... have it pasted form wsPaste cell E401 on
                Case "L:R" '<~~ if columns range L to R is involved, then...
                   Set rngPaste = wsPaste.Range("I401") '<~~ ... have it pasted form wsPaste cell I401 on
            End Select

            If Not rngPaste Is Nothing Then '<~~ check to see if any rngPaste has been set
                If Me.CheckBox1.Value Then
                    rngPaste.Select
                    rngCopy.Copy
                    ActiveSheet.Paste link:=True
                Else
                    rngCopy.Copy rngPaste
                End If
            End If

        Next rngCopy

        If Me.CheckBox1 Then
            wsActive.Select '<~~ if necessary, return to starting active sheet
        End If

    Else
        MsgBox "Please select Input range"
    End If
End Sub

---

solution B

I understand it simply suffices the user selects a single cell in a sheet and then you'll copy cells from relevant columns in that cell row and paste them into wsPaste sheet starting from corresponding cell addresses:

Private Sub CommandButton1_Click()
    Dim rngSelected As Range, rngCopy As Range
    Dim wsCopy As Worksheet, wsPaste As Worksheet, wsActive As Worksheet

    If RefEdit1.Value <> "" Then

        Set rngSelected = Range(Replace(RefEdit1.Text, ";", ",")).Areas(1).Cells(1, 1).EntireRow '<~~ store the selected range. Note:I had to use this Replace since my country customization has addresses returned by RefEdit control Text property separated by a ";" instead of a ","
        Set wsCopy = rngSelected.Parent
        Set wsPaste = ThisWorkbook.Sheets("Working Sheet")

        If Me.CheckBox1 Then '<~~ if requested...
            Set wsActive = ActiveSheet ''<~~ ... store active sheet for eventually returning to it...
            wsPaste.Select ''<~~  ... and activate "wsPaste" sheet once for all and avoid sheets jumping
        End If

        Set rngCopy = Intersect(rngSelected, wsCopy.Columns("A:D"))
        If Not rngCopy Is Nothing Then copyrng rngCopy, wsPaste.Range("A401"), Me.CheckBox1

        Set rngCopy = Intersect(rngSelected, wsCopy.Columns("I:J"))
        If Not rngCopy Is Nothing Then copyrng rngCopy, wsPaste.Range("E401"), Me.CheckBox1

        Set rngCopy = Intersect(rngSelected, wsCopy.Columns("L:R"))
        If Not rngCopy Is Nothing Then copyrng rngCopy, wsPaste.Range("I401"), Me.CheckBox1

        If Me.CheckBox1 Then
            wsActive.Select '<~~ if necessary, return to starting active sheet
        End If

    Else
        MsgBox "Please select Input range"
    End If

End Sub

Sub copyrng(rngCopy As Range, rngPaste As Range, okLink As Boolean)
    If Not rngCopy Is Nothing Then
        If okLink Then
            rngPaste.Select
            rngCopy.Copy
            ActiveSheet.Paste link:=True
        Else
            rngCopy.Copy rngPaste
        End If
    End If
End Sub

---

of course, both solutions still can be optimized, for instance:

• store both copying columns and corresponding pasting cells into arrays

  this, to have a loop processing each "pair". so that in case your need will change again (and most probably they will...) you'll only have to add elements to the arrays while not changing code

• add RefEdit return text validation

  this control accepts anything typed from the user so you may want to add a check that it's really returning a valid range something like

  If Not Range(RefEdit1.Text) Is Nothing Then... '<~~ if you expect only one selection

  or

  If Not Range(Range(Replace(RefEdit1.Text, ";", ",")).Areas) Is Nothing Then... '<~~ if you expect more then one selection