Excel：将多列组合到新工作表中，但不包含列名称

Question

下面的代码将多个列从一个Worksheet组合到一个新的/现有的列表中（名为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) 

这应该做的伎俩