View Single Post
Staro 30.07.2013., 09:49   #2
dema6
Premium
 
dema6's Avatar
 
Datum registracije: Mar 2009
Lokacija: Zagreb
Postovi: 41
Ako ti jos uvijek treba ...

Code:
Sub pcex()
Dim rng As Range
Dim i As Integer

Selection.CurrentRegion.Select

For Each rng In Selection
If InStr(rng.Text, "/") > 0 Then
Range(Cells(rng.Row, 1), Cells(rng.Row, 1).End(xlToRight)).Select
Selection.Copy
i = Cells(rng.Row - 1, 1).End(xlToRight).Column
Cells(rng.Row - 1, i + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
rng.EntireRow.Delete
End If

Next

End Sub
Samo selektiraj prvu celiju di trebas sortiranje,
također pretpostavka je da se krece od prve columne ... ako ne javi pa editiram kod
dema6 je offline   Reply With Quote