Excel：将多列合并到没有列名的新工作表中

Question

我下面的代码将一个工作表中的多个列组合成一个新的/现有的（名为MasterList）到一个列中。

我遇到的问题是每一列都有一个列名，该列名被放入新工作表中。列名始终位于第 1 行。

Sub ToArrayAndBack()
Dim arr As Variant, lLoop1 As Long, lLoop2 As Long
Dim arr2 As Variant, lIndex As Long

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

ReDim arr2(ActiveSheet.UsedRange.Cells.Count - ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Count)

arr = ActiveSheet.UsedRange.Value


For lLoop1 = LBound(arr, 1) To UBound(arr, 1)
    For lLoop2 = LBound(arr, 2) To UBound(arr, 2)
        If Len(Trim(arr(lLoop1, lLoop2))) > 0 Then
            arr2(lIndex) = arr(lLoop1, lLoop2)
            lIndex = lIndex + 1
        End If
    Next
Next

Dim ws As Worksheet
Dim found As Boolean
found = False
For Each ws In ThisWorkbook.Sheets
    If ws.Name = "MasterList" Then
        found = True
        Exit For
    End If
Next
If Not found Then
    Sheets.Add.Name = "MasterList"
End If

Set ws = ThisWorkbook.Sheets("MasterList")
With ws
     .Range("A1").Resize(, lIndex + 1).Value = arr2

     .Range("A1").Resize(, lIndex + 1).Copy
     .Range("A2").Resize(lIndex + 1).PasteSpecial Transpose:=True
     .Rows(1).Delete
End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With


End Sub

回顾一下，我想使用此代码将一个工作表中的多个列组合到另一个没有列名的工作表中。

Answer 1

arr = ActiveSheet.UsedRange.Resize(ActiveSheet.UsedRange.Rows.Count-1,ActiveSheet.UsedRange.Columns.Count).Offset(1,0)

这应该可以解决问题