Sub bbb
startt = Now()
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True
Rows("1:1").Insert shift:=xlDown
For i = 1 To 15
Cells(1, i).Value = "H" & i
Next i
outcol = 26
For i = 1 To 15
Columns(i).AdvancedFilter Action:=xlFilterCopy, copytorange:=Cells(1, outcol), unique:=xlYes
outcol = outcol + 1
Next i
For i = 27 To 40
If Len(Cells(2, i)) > 0 Then
Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp)).Copy Destination:=Cells(Rows.Count, 26).End(xlUp).Offset(1, 0)
End If
Next i
Columns(26).AdvancedFilter Action:=xlFilterCopy, copytorange:=Cells(1, 52), unique:=xlYes
MsgBox startt & ", " & Now()
End Sub
I just repeatedly copied your data until it had about 230k rows, and it took about 11 seconds to action. Output is in column AZ
Bookmarks