Вставка столбцов из других листов в виде строки на другом листе

Question

Я пытаюсь написать скрипт, который будет брать данные из столбцов на двух разных листах и ​​вставлять их в строку на третьем листе без перезаписи друг друга.

Private Sub CommandButton1_Click()
 Dim InRangex1 As Range
 Dim OutRangex1 As Range

 Dim i As Long

 Set InRangex1 = Sheets("Line 1").Range("L4:L204")
 Set OutRangex1 = Sheets("Numeric Plot").Range("B1")
 InRangex1.Worksheet.Activate
 InRangex1.Select
 Selection.Copy
 OutRangex1.Worksheet.Activate
 OutRangex1.Select
 Selection.PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True, Transpose:=True

 Dim InRangex2 As Range
 Dim OutRangex2 As Range

 Set InRangex2 = Sheets("Line 3").Range("L4:L204")
 Set OutRangex2 = Sheets("Numeric Plot").Range("B1").End(xlToRight).Offset(0, 1).Select
 InRangex2.Worksheet.Activate
 InRangex2.Select
 Selection.Copy
 OutRangex2.Worksheet.Activate
 OutRangex2.Select
 Selection.PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True, Transpose:=True

End Sub

Я получаю 424 " "Требуется объект" ошибка при запуске второй половины скрипта. Не уверен, где проблема.

Answer 1

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

Private Sub CommandButton1_Click()
 Dim arr1 As Variant, arr2 As Variant, OutRangex2 As Range

 arr1 = Sheets("Line 1").Range("L4:L204").Value
 Sheets("Numeric Plot").Range("B1").Resize(1, UBound(arr1, 1)).Value = WorksheetFunction.Transpose(arr1)

 arr2 = Sheets("Line 3").Range("L4:L204").Value
 Set OutRangex2 = Sheets("Numeric Plot").Range("B1").End(xlToRight).Offset(0, 1)
  OutRangex2.Resize(1, UBound(arr2, 1)).Value = WorksheetFunction.Transpose(arr2)
End Sub

Я думаю, что удаление дубликатов должно рассматриваться как объект нового вопроса, в соответствии с нашими правилами. .

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

Sub removeDuplicate()
 Dim arrSort As Variant, lastCol As Long, lastRow As Long, arrSorted As Variant, sh As Worksheet
  Set sh = Sheets("Numeric Plot")
  lastCol = sh.Cells(1, sh.Cells.Columns.count).End(xlToLeft).column 'last col on the first row
  arrSort = sh.Range(sh.Cells(1, 2), sh.Cells(1, lastCol)).Value        'put the row values in an array
  'transpose the array in a column after the last one of the rows 1:
  sh.Cells(1, lastCol + 1).Resize(UBound(arrSort, 2), 1).Value = WorksheetFunction.Transpose(arrSort)
  'remove duplicates with Excel function:
  sh.Range(sh.Cells(1, lastCol + 1), sh.Cells(UBound(arrSort, 2), lastCol + 1)).RemoveDuplicates Columns:=1, Header:=xlNo
  lastRow = sh.Cells(sh.Cells.Rows.count, lastCol + 1).End(xlUp).row 'Last row after dupplicate elimination
  arrSorted = sh.Range(sh.Cells(1, lastCol + 1), sh.Cells(lastRow, lastCol + 1)).Value 'The cleared column pun in an array
    sh.Range(sh.Cells(1, 2), sh.Cells(1, lastCol)).Clear                     'clearing the data of the first row
    sh.Range(sh.Cells(1, lastCol + 1), sh.Cells(lastRow, lastCol + 1)).Clear 'clearing the data of temporary column
    Dim finalRng As Range
     Set finalRng = sh.Range("B1").Resize(1, UBound(arrSorted))
    finalRng.Value = WorksheetFunction.Transpose(arrSorted) 'transpose the fiterred array

   'sort the resulted range:
   finalRng.Sort Key1:=finalRng, Order1:=xlAscending, Orientation:=xlLeftToRight
End Sub