Copy in clipboard the content of 5 columns from 5 different sheets

Question

For the exemple, let's concider a Wb "Wb02" with 2 sheets. Each sheet contain the same two columns table but with différents values.

In another workbook "Wb01", I made 2 buttons to reach a specific sheet of "WB02" and copy to the clipboard the values of the column "B" with a delimiter ";" between each value.

Now I would like a new button to copy all columns "B" values of each sheets of "Wb02" with a delimiter ";" between each value.

here is my code so far :

Sub SaveInCb()
  Dim Data As Variant
  Dim Txt As String
  Dim Wb02 As Workbook

  Set Wb02 = Workbooks.Open("myExcelPath") 

  If Application.caller = "BT01" Then
    Data = Wb02.Range("Table1[columnB]").value
  Else If Application.caller = "BT02" Then
    Data = Wb02.Range("Table2[columnB]").value
  Else If Application.caller = "BT01_BT02" Then
    ' This is want I want to do, but it's not working like that
    Data = Wb02.Range("Table1[columnB]").value & Wb02.Range("Table2[columnB]").value
  End If

  For i = 0 To UBound(Data, 1)
    If not IsEmpty(Data(i, 1)) Then
      Txt = Txt & Data(i, 1) & ";"
    End If
  Next i

  If Len(Txt) > 0 Then
    Txt = Left(Txt, Len(Txt)-2)
  End If

  Shell "cmd.exe /c" & echo """ & Txt & """| clip", vbHide

End Sub

Answer 1

Please, try the next code. It is commented in a way to understand what each code line does:

Sub placeTwoColumnsStringInClipboard()
  Dim wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet, rng1 As Range, rng2 As Range
  Dim lastR As Long, arr1, arr11, arr2, arr22
  Const strStrange As String = "%$#@"
  
  Set wb2 = ActiveWorkbook 'use here the one you need
  Set ws1 = wb2.Sheets(1)
  Set ws2 = wb2.Sheets(2)
  
  lastR = ws1.Range("B" & ws1.rows.count).End(xlUp).Row 'last row in the first sheet
  Set rng1 = ws1.Range("B2:B" & lastR)
  arr1 = rng1.value
  
  lastR = ws2.Range("B" & ws2.rows.count).End(xlUp).Row 'last row in the first sheet
  Set rng2 = ws2.Range("B2:B" & lastR)
  arr2 = rng2.value
  
  
  'transform 2D column arrays in 1D and remove the empty cells:
  rng1.Replace "", strStrange, xlWhole: ' Stop
  arr11 = Application.Transpose(rng1.value) 'place the columln range in a 1D array
  arr11 = filter(arr11, strStrange, False)   'remove the former empty cells
  'Debug.Print Join(arr11, "|"): 'just to visually see it
  rng1.value = arr1 'place back the former range, spaces included
  
  rng2.Replace "", strStrange, xlWhole: 'Stop
  arr22 = Application.Transpose(rng2.value) 'place the columln range in a 1D array
  arr22 = filter(arr22, strStrange, False)   'remove the former empty cells
  'Debug.Print Join(arr22, "|"): ''just to visually see it
  rng2.value = arr2 'place back the former range, spaces included
  
  
  Dim arr3, Txt As String
  Join1DArrays arr3, arr22, arr11 'modified the order of the necessary array parameters!
  Txt = Join(arr3, ";") 'the necessary string
  Debug.Print Txt 'the necesssary string!!!
  
  'Added to test the new function for the next array:
  Dim arr4
  arr4 = Array(1, 3, 5, 7, 9, 11)
  Join1DArrays arr3, arr4
  Txt = Join(arr3, ";") 'the necessary string
  Debug.Print Txt 'see here the final string (including  arr4 content, too)!!!
  'Proceed in the same way for as many arrays you produce.
  'You can reuse the above arrays except arr3. They have never been re-dimensioned...
  'And use the above shown way. It is faster, compact, without iteration and no any condition.
End Sub

Sub Join1DArrays(arr3, arrr, Optional arr As Variant)'modified (the order of variables and the logic to except two necessary arrays)
   Dim i As Long, istart As Long

   If Not IsArray(arr3) Then arr3 = arr
   istart = UBound(arr3) 'where from the iteration to load the rest should start
   ReDim Preserve arr3(istart + UBound(arrr) + 1)
   
   For i = istart + 1 To UBound(arr3)
        arr3(i) = arrr(i - istart - 1)
   Next i
End Sub

If something not clear enough, please, do not hesitate to ask for clarifications...