Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Przesuń wszystko do góry, jeśli zakres jest pusty

schuvi · Exceloholic Wersja: Win Office 2019 Posty: 158

Właśnie wypróbowałem.
Jest taki problem ze: po przesunięciu, kopiuje na wszystkie wiersze wartości z wiersza początkowego 2.
Zmienię wszystko w wierszu 2, i wyczyszczę inny, makro powtarza to samo. Co jest w wierszu 2, ląduje w pozostałych wypełnionych.

Tajan · **Pomógł:** 5234 razy Posty: 11412

Sorry, ale wkradł się błąd. Zmień linię:

Kod:

arr(x, j) = .Cells(1, j).Value

na

Kod:

arr(x, j) = .Cells(i, j).Value

czyli "1" na "i".

schuvi · Exceloholic Wersja: Win Office 2019 Posty: 158

Tajan,

dziękuję. Diała wyśmienicie.
Jedno pytanko tylko. Jeśli będę chciał, by nie omijało czyszczeniem kolumny J, (gdybym z zrezygnował z formuły w tej kolumnie, i wstawiał jakiś tekst), to jak ten wyjątek usunąć?

Tajan · **Pomógł:** 5234 razy Posty: 11412

Użyj tej wersji:

Kod:

Sub MoveRowsUp()
'Aktualizuj dane / przesuń do góry
Dim i As Long, j As Long, x As Long, empt As Range
Dim arr(), rw As Range

With Range("A2:M400")

ReDim arr(1 To .Rows.Count, 1 To .Columns.Count)

For i = 1 To .Rows.Count

Set rw = .Rows(i).Cells

If Application.CountA(rw) > 0 Then

If .Cells(i, 1).Value = "" Then
Application.Goto rw
MsgBox "Nie wszystkie komórki zostały wyczyszczone!"
Exit Sub
End If

x = x + 1

For j = 1 To .Columns.Count
arr(x, j) = .Cells(i, j).Value
Next
Else
Set empt = Union(IIf(empt Is Nothing, rw, empt), rw)
End If

Next

If Not empt Is Nothing Then .Value = arr

End With

End Sub

schuvi · Exceloholic Wersja: Win Office 2019 Posty: 158

Dzięki za szybką odpowiedż. Może się kiedyś przyda.

Pozdrawiam