[es] - macro za kopiranje u master sheet

vojvoda1010
nezaposlen

Član broj: 310516
Poruke: 547
95.180.110.*

+2 Profil

^{13.06.2016. u 09:26 - pre 95 meseci}

Sub CopyToMaster()
ShtCount = ActiveWorkbook.Sheets.Count
For i = 2 To ShtCount
Worksheets(i).Activate
Range("A7:C44").Select
Selection.Copy
Sheets("Master").Activate
'Required after first paste to shift active cell down one
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop

Selection.PasteSpecial

Next i
End Sub

Nasao sam ovaj code koji sam malo preradi (amaterski), sigurno moze i bolje, posto ne znam gde treba da izmenim da bi mi kopirao sa redom razmaka izmedju podataka (podatak iz sheet1 pa razmak jedan red pa podatak sheet2 pa razmak pa sheet3 itd)?
Ovaj macro kopira neki rang iz svih sheet-ova u jedan master.
Mene zanima (pored onog razmaka) kako da se preurei code i da kopira vise rangova u master znaci pored Range("A7:C44") i jos 3 range A100:A150, A200:A250 i A300:A350?

Sheet master i ostali sheet-ovi su u jednom workbook-u.

Odgovor na temu

vojvoda1010
nezaposlen

Član broj: 310516
Poruke: 547
95.180.110.*

+2 Profil

Re: macro za kopiranje u master sheet

^{15.06.2016. u 09:41 - pre 95 meseci}

Sub CopyToMaster()
ShtCount = ActiveWorkbook.Sheets.Count
For i = 2 To ShtCount
Worksheets(i).Activate
Range("A7:C44").Select
Selection.Copy
Sheets("Master").Activate
'Required after first paste to shift active cell down one
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop

Selection.PasteSpecial

Next i
End Sub

za kopiranje vise rangova nasao sam neko resenje (verovatno moze i bolje i jednostavnije), u koloni
Range("A7:C44").Select, iza ranga A7:C44 staviti "," pa sleeci rang i tako do poslednjeg kojeg zelite kopirati.
Nisam nasao resenje jos za razmak u master shett-u za jedan ili dva reda???

Odgovor na temu

vojvoda1010
nezaposlen

Član broj: 310516
Poruke: 547
95.180.110.*

+2 Profil

Re: macro za kopiranje u master sheet

^{15.06.2016. u 12:49 - pre 95 meseci}

Sub CopyToMaster()

ShtCount = ActiveWorkbook.Sheets.Count

For i = 2 To ShtCount

Worksheets(i).Activate
LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row

Range("A2:J" & LastRow).Select

Selection.Copy
Sheets("Master").Activate

LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Select

'Required after first paste to shift active cell down one
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop

ActiveCell.Offset(0, -3).Select
Selection.PasteSpecial

Next i
End Sub

ovo je orginalni code koji sam ja preuredio(na neki nacin) ali verovatno ovde moze sa razmakom izmedju rangova razmak red pa sledeci rang???

Odgovor na temu