przykład.xls

VBA Excel - kopiowanie z kilku arkuszy wtedy gdy

Hej, czy mógłby ktoś mi pomóc poprawić poniższy kod, który ma pobierać do Arkusza "BAZA" dane ze wszystkich pozostałych arkuszy w tym skoroszycie, jeśli wiersze zaczynają się od niepustej komórki A. Problem polega na tym że jeśli w którymś arkuszu w kolumnie A jest pusty wiersz, to makro nie pomija tego pustego wiersza idąc do następnego wiersza w tym danym arkuszu, tylko przechodzi do następnego arkusza... np jak w załączonym przykładzie żeby z arkusza2 pobierało wiersze które w kolumnie A (Lp. ) mają wartości 1 i 2 , a z Arkusza3 wartości 1,2 i 3 - żeby czyynikiem decydującym był własnie fakt czy niepusta jest kolumna A, niezaleznie od tego ile kolumn w danym wierszu jest jest uzupełnionych. z góry dzięki za pomoc Sub kopiuj() Application.ScreenUpdating = False Set Rng = Sheets("BAZA") Rng.Range(Range("B7:L7"), Range("B7:L7").End(xlDown)).ClearContents For i = 2 To Sheets.Count Sheets(i).Activate Range("A2").Select Do Until ActiveCell.Value = 0 If Rng.Range("c2").Value <> "" Then Nextrow = Application.WorksheetFunction.CountA(Rng.Range("B:B")) + 5 Else Nextrow = Application.WorksheetFunction.CountA(Rng.Range("B:B")) + 6 End If Range(ActiveCell.Offset(0, 1), ActiveCell.End(xlToRight)).Copy Rng.Cells(Nextrow, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ActiveCell.Offset(1, 0).Range("A1").Select Loop Next i With Rng .Activate .Range("B7").Select End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub


, &quot; 1 &quot; , &quot; 2 &quot; , &quot; 3 &quot; , &quot; 4 &quot; , &quot; 5 &quot; , &quot; 6 &quot; , &quot; 7 &quot; , &quot; 8 &quot; , &quot; 9 &quot; , &quot; 10 &quot;
,
, &quot; 1 &quot; , &quot; 2 &quot; , &quot; 3 &quot; , &quot; 4 &quot; , &quot; 5 &quot; , &quot; 6 &quot; , &quot; 7 &quot; , &quot; 8 &quot; , &quot; 9 &quot; , &quot; 10 &quot;
, &quot; ark 2 1 &quot; , &quot; s &quot; , &quot; d &quot; , &quot; f &quot; , &quot; g &quot; , &quot; h &quot; , &quot; j &quot; , &quot; k &quot; , &quot; l &quot; , &quot; ; &quot;
, &quot; Ark 3s &quot; , &quot; ark3 1 &quot;
&quot; Lp &quot; , &quot; 1 &quot; , &quot; 2 &quot; , &quot; 3 &quot; , &quot; 4 &quot; , &quot; 5 &quot; , &quot; 6 &quot; , &quot; 7 &quot; , &quot; 8 &quot; , &quot; 9 &quot; , &quot; 10 &quot;
&quot; 1 &quot; , &quot; ark 2 1 &quot; , &quot; s &quot; , &quot; d &quot; , &quot; f &quot; , &quot; g &quot; , &quot; h &quot; , &quot; j &quot; , &quot; k &quot; , &quot; l &quot; , &quot; ; &quot;
, &quot; ark 2 2 &quot; , &quot; q &quot; , &quot; w &quot; , &quot; e &quot; , &quot; r &quot; , &quot; t &quot; ,, &quot; u &quot; ,, &quot; i &quot;
&quot; 2 &quot; ,, &quot; ark 2 c &quot; ,, &quot; e &quot; ,,, &quot; r &quot; ,, &quot; t &quot; , &quot; r &quot;
&quot; Lp &quot; , &quot; 1 &quot; , &quot; 2 &quot; , &quot; 3 &quot; , &quot; 4 &quot; , &quot; 5 &quot; , &quot; 6 &quot; , &quot; 7 &quot; , &quot; 8 &quot; , &quot; 9 &quot; , &quot; 10 &quot;
&quot; 1 &quot; ,, &quot; ark3 1 &quot; ,, &quot; s &quot; , &quot; s &quot; ,,,, &quot; s &quot; , &quot; s &quot;
&quot; 2 &quot; , &quot; Ark 3s &quot; ,, &quot; s &quot; ,,, &quot; d &quot; ,, &quot; s &quot; ,, &quot; d &quot;
,, &quot; ark3 d &quot; , &quot; s &quot; ,, &quot; s &quot; ,, &quot; a &quot; , &quot; ddf &quot;
&quot; 3 &quot; , &quot; fds &quot; , &quot; ark3 d &quot; , &quot; sdf &quot; , &quot; dsf &quot; , &quot; ds. &quot; ,, &quot; sd &quot; ,,, &quot; sd &quot;


Pobierz plik - link do postu