This macro combine all of the columns in an active sheet and appends them to a new column in a worksheet named Mainlist.
The problem that I am facing is that this macro is combining the headers (column names) into the appended column. I need to fix this code so that starts copying at row 2.
I am new to VBA. Please help.
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
Start your loops at LBound() + 1
, like this:
For lLoop1 = LBound(arr, 1) + 1 To UBound(arr, 1)
For lLoop2 = LBound(arr, 2) + 1 To UBound(arr, 2)
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.