If cell.Value < 0 Then
cell.EntireRow.Copy Worksheets("Arkusz3").Range("A" & wiersz)
wiersz = wiersz + 1 Else
cell.Interior.ColorIndex = REDINDEX EndIf
Hej
napisał: baldok postów: 1
umieszczony: 25 sierpnia 2008 14:39
Witam. nie wiem, co mam nie tak w tym kodzie. Chodzi o to ze program ma wyszukać w wierszach wartości ujemne. Gdy znajdzie wartosc ujemna w komórce zaznacza caly wiersz i kopiuje go do następnego arkusza. problem w tym, ze program kopiuje wszystkie wiersze jeden na drugi, a nie pod kolejnym wolnym wierszem. Z gory dzieki za wszystkie podpowiedzi. pozdro
Sub CommandButton1_Click()
Dim cell As Range
Dim wiersz As Long
If TypeName(Selection) <> "Range" Then Exit Sub
Const REDINDEX = 3
wiersz = Worksheets("Arkusz3").Range("A50").End(xlUp).Row + 1
Application.ScreenUpdating = False
For Each cell In Selection
If cell.Value < 0 Then
cell.EntireRow.Select
Selection.Copy Worksheets("Arkusz3").Range("A" & wiersz)
Else
cell.Interior.ColorIndex = REDINDEX
End If
Next cell
wstecz 1 dalej
otwarty rozpoczął: baldok
postów: 2
