2015-03-13 49 views
0

該宏組合活動工作表中的所有列,並將它們附加到名爲Mainlist的工作表中的新列。設置範圍在宏的第2行開始

我面臨的問題是這個宏將標題(列名)組合到附加列中。我需要修復此代碼,以便在第2行開始複製。

我是VBA的新手。請幫忙。

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 

回答

1

LBound() + 1啓動循環,像這樣:

For lLoop1 = LBound(arr, 1) + 1 To UBound(arr, 1) 
    For lLoop2 = LBound(arr, 2) + 1 To UBound(arr, 2) 
+0

我想我愛你! – user4581436 2015-03-13 21:07:17

+1

哇! :) 很高興我能幫上忙。 – FreeMan 2015-03-13 21:09:39

+0

如何將這些粘貼值從Masterlist表格中的A2開始?我想這將與這個代碼有關:使用ws .Range(「A1」)。Resize(,lIndex + 1).Value = arr2 .Range(「A1」)。Resize(,lIndex + 1) 。複製 .Range(「A2」)。Resize(lIndex + 1).PasteSpecial Transpose:= True .Rows(1).Delete End With# – user4581436 2015-03-17 21:32:40