VBA Tools

Jeden z forumowiczów zadał pytanie o możliwość przeniesienia z zaznaczonego lub zdefiniowanego obszary dane do jednej kolumny. Poniżej pokazuje rozwiązanie.

Sub przenies_do_jednej_kolumny()
Dim el As Range, max_row&, zakr As Range, y&
Set zakr = Selection 'range("a1:g12")
max_row = Cells(Rows.Count, zakr.Column).End(xlUp).Row
Application.ScreenUpdating = False
For Each el In zakr
 If el.Column > 1 Then
 If Len(el.Value) > 0 Then
 y = y + 1
 Cells(max_row + y, zakr.Column) = el
 el.Clear
 End If
 End If
Next el
max_row = Cells(Rows.Count, zakr.Column).End(xlUp).Row
For y = max_row To zakr.Row Step -1
 If Len(Cells(y, zakr.Column)) = 0 Then Cells(y, zakr.Column).Delete Shift:=xlUp
Next y
Set zakr = Nothing
Application.ScreenUpdating = True
End Sub

Rys 1. Efekt przed i po zastosowaniu procedury

Aby dokończyć dzieła można taką kolumnę danych odfiltrować z duplikatów a następnie zaimportować do autofiltra lub pozostawić dla innych nieopisanych tutaj celów.

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.