Скопируйте пасту три разных диапазона в пользовательской форме

Question

У меня есть два листа. L12 Database и Working Sheet. У меня есть пользовательская форма, которая копирует строки данных с любого листа в диапазон A393 рабочего листа. Однако я понял, что мне нужно только скопировать некоторые данные столбцов этой строки, а не всю строку. Он разделен на 3 диапазона, L12 Database should copyColumns A:D, I:J, and L:R. Скопированные данные должны быть paste в Working SheetColumnsA:D,E:F and I:O. Предыдущее предложение состояло в том, чтобы выполнить цикл, но оно применимо только к двум диапазонам. Поэтому мне понадобится помощь в том, как я могу копировать и вставлять три диапазона в одну пользовательскую форму. Это был код, сделанный пользователем stackoverflow (Извините, я не помню ваше имя), что я и хочу делать. Благодаря!

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 

Это был UserForm код, который я сделал ранее:

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

отредактирован: исправить Areas "Решение A" объект обработки. и добавил, что «обработка rngPaste

Я брошу в двух решений

---

раствор А

следуя вашей "схеме"

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 

---

раствор Б

Я понимаю, что это просто достаточно пользователь выбирает одну ячейку в листе, а затем вы будете копировать ячейки из соответствующих столбцов в этой строке ячейки и вставить их в wsPaste запуска листа из соответствующих ячеек по адресам:

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 

---

конечно, оба решения все еще могут быть оптимизированы, например:

• магазин как копирование столбцов и соответствующие оклейки клеток в массивах

  это, чтобы иметь петлю, обрабатывающую каждую «пару». так что если ваша потребность снова изменится (и, скорее всего, они ...) Вы будете иметь только для добавления элементов в массивы не меняя код

• проверка добавить RefEdit возврата текста

  этот контроль принимает ничего набранного от пользователя , так что вы можете добавить проверку, что это действительно возвращает допустимый диапазон что-то вроде

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

  или

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