[Excel] Makro za kopiranje

[Excel] Makro za kopiranje 12.09.2006. u 09:05 · pre 245 meseci #1

Koristim makro za kopiranje koji kopira vrednosti iz Sheet1 u Sheet2 i to u prvi prazan red Sheet2

[code
Code:
Sub Button1_Click()
' Makro koji snima podatke iz opsega C1:F1 u prvi prazan red
' na sledecem listu

' Selektovanje i kopiranje opsega
Range("C1:F1").Select
Selection.Copy
' Prelazak u Sheet2
Sheets("Sheet2").Select
' Pozicioniranje na prvu praznu ?eliju u koloni A
Range("A65536").End(xlUp).Offset(1, 0).Select
' Kopiranje po vrednosti
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
' Povratak na Sheet1
Sheets("Sheet1").Select

End Sub]

Kako da resim 2 problema:
1. U Sheet1 se nalaze podaci koji u zavisnosti od slucaja da slucaja mogu biti u razlicitim redovima (sa preskocenim radovima) Na primer:
1. Slucaj koji se kopira
C1:F1
C4:F4
C6:F6
2. Slucaj koji se kopira
C1:F1
C3:F3
3. Slucaj koji se kopira
C4:F4
C5:F5
C7:F7

Kako ovakve vrednosti kopirati u Sheet2 tako da podaci budu kopirani u uzastopne redove (bez preskakanja)

2. Kako na slican nacin kopirati odredjenu tabelu (obrazac) u kome su odredjene celije spojene (Merge cells). Obrazac je uvek standardan (isti broj redova i kolona)

Re: pomoc oko makroa ya kopiranje 12.09.2006. u 10:01 · pre 245 meseci #2

Da počnem od lakšeg
2/ Standardno kopiranje kopira i mergovane ćelije. Jednostavno snimi makro koji kopira ceo obrazac - obavezno uključi sve mergovane redove kolone - i to je to. Problem moze da bude jedino ukoliko su na odredišnom listu neke druge ćelije već mergovane - u tom slučaju pre kopiranja treba ukloniti mergovanje svih ćelija na odredišnom listu.

1/ Ovo menja koncepciju kopiranja - jer prilikom kopiranja treba preskočiti prazne redove. U tvom slučaju čini mi se najlakše da se doda petlja koja briše prazne redove nakon kopiranja. Dakle pre povratka na Sheet1 treba obrisati prazne redove

Code:

Sub Button1_Click()
' Makro koji snima podatke iz opsega C1:F1 u prvi prazan red
' na sledecem listu

Dim r As Long
Dim i As Long
' Selektovanje i kopiranje opsega
Range("C1:F9").Select
Selection.Copy
' Prelazak u Sheet2
Sheets("Sheet2").Select
' Pozicioniranje na prvu praznu ?eliju u koloni A
r = Range("A65536").End(xlUp).Offset(1, 0).Row ' cuva se pocetni broj reda
ActiveSheet.Cells(r, 1).Select
' Kopiranje po vrednosti
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
'Brisanje praznih redova
For i = r + 8 To r Step -1 ' Proveravaju se poslednjih devet redova
If ((Len(Cells(i, 1).Text) + Len(Cells(i, 2).Text) + Len(Cells(i, 3).Text) + Len(Cells(i, 4).Text)) = 0) Then
ActiveSheet.Rows(i).Delete Shift:=xlDown ' Ukoliko je prazan red se brise
End If
Next i
' Povratak na Sheet1
Sheets("Sheet1").Select

End Sub

Potpis

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Re: pomoc oko makroa za kopiranje 13.09.2006. u 09:17 · pre 245 meseci #3

Hvala J Peci na pomoci
Što se tice drugog pitanja mislio sam na kopiranje tabele ispod prethodno iskopirane u prvi prazan red. Prethodno iskopirana tabela sadrzi mergovane celije kao i prazne redove (unutar tabele).

Forum kao aplikacija na telefonu

Srodne teme