[Excel] Automatizacija kopiranje tabele

[ Jpeca @ 21.02.2007. 07:52 ] @

Ako je ovo samo jednokratan postupak verovatno je lakše kopirati kombinujući formule i copy/paste bez obzira na veličinu broj redova, nego pisati i testirati program. Ipak, pošto mi se primer čini jednostavan i ilustrativan i za ostale koji žele da nauče rad sa makroima, evo kako bi to moglo da se uradi. (Zato i malo više objašnjenja)
Osnovni način pristupa ćeliji iz programa je koristeći Range objekat radnog lista npr. za ćeliji B7 na radnom listu 1 može se postaviti vrednost "Test"

Code:
Sheets(1).Range("B7").Value = "Test"

Umesto konkretnog broja (ili naziva) lista može se koristiti ActiveSheet da se referencija na aktivni list. Slično koristi se ActiveWorkbook da se referencira na aktivnu radnu svesku ukoliko ima više otvorenih. Drugi način je koristeći Cells objekat radnog lista. Za isti primer:

Code:
Sheets(1).Cells(7,2).Value = "Test"

Ovaj metod koristi broj reda i kolone ćelije pa je pogodniji kada se više ćelija popunjavaju jedna za drugom u nekoj programskoj petlji. Taj način korišćen je i u kopiranju koje si ti tražio. U ovom slučaju korišćeno je dve petlje - jedna koja ide po redovima izvorne tabele i druga koja za isti red izvorne tabele prepisuje vrednosti iz četiri kolona.

Code:

Sub Prepis()
' Primer prepisivanja sadrzaja
' sa jednog lista na drugi
'
' P.Jovanovic za elitesecurity.org
'
'
Dim shSource As Worksheet
Dim shDest   As Worksheet
Dim rw As Long            ' brojac redova izvorne tabele
Dim rwEnd As Long
Dim r As Long              ' brojac redova odredisne tabele
Dim i As Integer
' Inicijalizacije
Set shSource = ActiveWorkbook.Sheets(1) ' list sa izvornim podacima
Set shDest = ActiveWorkbook.Sheets(3)   ' list sa prepisanim podacima
' Odredjivanje poslednjeg reda u izvornoj tabeli
rwEnd = shSource.Range("A65535").End(xlUp).Row
r = 2 ' Pocetni red za upis u odredisni list
' Glavna petlja
For rw = 3 To rwEnd
    For i = 1 To 4
       shDest.Cells(r, 1).Value = shSource.Cells(rw, 1).Value
       shDest.Cells(r, 2).Value = shSource.Cells(rw, 2).Value
       shDest.Cells(r, 3).Value = shSource.Cells(2, i + 1).Value
       shDest.Cells(r, 4).Value = shSource.Cells(rw, i + 2).Value
       r = r + 1 ' Sledeci red za upis
    Next i
Next rw
End Sub

Interesantno je i određivanje poslednjeg reda izvorne tabele za prepis, za šta objašnjenje možeš potražiti na sajtu praktikuma http://www.praktikum.co.yu/office/excel/xl_041.htm

_{[Ovu poruku je menjao Jpeca dana 21.02.2007. u 14:44 GMT+1]}