![](/img/trans.png)
[英]Is it possible to select a range of data via a macro if the start and end row is variable?
[英]Set Range to Start at Row 2 in a Macro
此宏將活動工作表中的所有列組合在一起,並將它們追加到工作表中名為Mainlist的新列中。
我面臨的問題是此宏將標題(列名)組合到附加列中。 我需要修復此代碼,以便從第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
從LBound() + 1
開始循環,如下所示:
For lLoop1 = LBound(arr, 1) + 1 To UBound(arr, 1)
For lLoop2 = LBound(arr, 2) + 1 To UBound(arr, 2)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.