| Jak skopiować do nowego arkusza wiersze z kolorowym wypełnieniem? |
|
Problem: Potrzebuję makra, które przekopiuje mi wszystkie wiersze z kolorowym wypełnieniem do osobnego arkusza. ![]() Rozwiązanie: Możesz skorzystać z takiego makra: Option Explicit Sub KopiujWiersze() Dim rngZakresDocelowy As Excel.Range Dim rngWiersze As Excel.Range Dim lLicznik As Long 'Przypisuje zmienna do wszystkich wierszy w arkuszu 'Baza' Set rngWiersze = wksBaza.UsedRange.EntireRow 'Petla po wszystkich wierszach For lLicznik = 1 To rngWiersze.Rows.Count 'Jezeli wiersz jest wypelniony kolorem - dodaje jego zakres do zmiennej If rngWiersze.Rows(lLicznik).Interior.ColorIndex <> -4142 Then If Not rngZakresDocelowy Is Nothing Then Set rngZakresDocelowy = Union(rngZakresDocelowy, rngWiersze.Rows(lLicznik)) Else Set rngZakresDocelowy = rngWiersze.Rows(lLicznik) End If End If Next lLicznik 'Kopiuje zakres do nowego arkusza With wksKolory .Cells.Clear rngZakresDocelowy.Copy Destination:=.Range("A1") End With 'Niszczy zmienne obiektowe Set rngZakresDocelowy = Nothing Set rngWiersze = Nothing End Sub |
|
| Zmieniony ( Wtorek, 29. Czerwiec 2010 12:59 ) |
