Već sam pisao ranije o tome da automatsko ubacivanje reda nije dobro rešenje, jer se onda otvara problem oko istovremenog ažuriranja i brisanja
Obično se sumarni listovi dobijaju na osnovu Pivot tabele, ali ako ti treba samo prepis možeš primeniti sledeće rešenje
Napravi proceduru koja prepisuje sve redove iz jednog lista u drugi. Nju možeš da smestiš u poseban modul
Code:
Sub AddRows(shSource As Worksheet, shDest As Worksheet)
' Dodaje sve redove iz shSource
' na kraj radnog lista shDest
' P. Jovanovic za elitesecurity.org
'
Dim rwLast As Long
rwLast = shSource.Range("A65535").End(xlUp).Row ' odredjivanje poslednjeg popunjenog reda
shSource.Rows(1).Resize(rowsize:=rwLast).Copy
rwLast = shDest.Range("A65535").End(xlUp).Row ' odredjivanje poslednjeg popunjenog reda
If Len(shDest.Cells(rwLast, 1).Text) > 0 Then
rwLast = rwLast + 1 ' Red od kojeg se kopira 1- ili prvi prazan
End If
shDest.Cells(rwLast, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Na dogadjaj aktivacije lista sumarum izvrši prepisivanja iz lista A, B i C u taj list. Ovaj kod moraš staviti u kod radnog lista summarum
Code:
Private Sub Worksheet_Activate()
' Prilikom aktiviranja kopira se sadrzaj iz listova
' A, B, i C po vrednosti
'
Dim rwLast As Long
' Sprecavanje drugih dogadjaja i osvezavanja ekrana
Application.EnableEvents = False
Application.ScreenUpdating = False
' Brisanje prethodne liste
rwLast = ActiveSheet.Range("A65535").End(xlUp).Row ' odredjivanje poslednjeg popunjenog reda
ActiveSheet.Rows(1).Resize(rwLast).Delete
' Kopiranje redova iz listova
AddRows Sheets("A"), ActiveSheet
AddRows Sheets("B"), ActiveSheet
AddRows Sheets("C"), ActiveSheet
Application.CutCopyMode = False
ActiveSheet.Range("A1").Select
'
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Naravno ovo sad treba prilagoditi tvom primeru - da li kopiranje počinje od prvog reda ili ne i sl.
