[es] - Vise opsega iskopirane u jednoj koloni

inzenjerija
inzenjer
sta dodje pod ruku
Tutin

Član broj: 336351
Poruke: 48
*.dynamic.isp.telekom.rs.

+1 Profil

Vise opsega iskopirane u jednoj koloni

^{22.03.2018. u 16:22 - pre 73 meseci}

Pozdrav narode!

Imam problem oko kopiranja vise opsega u jednoj koloni
Primer koji je u attach-u ce Vam reci vise
U mom slucaju imam opsege:(B2:B7,C2:C7,D2:D7,E2:E7)
Rezultat bi trebao da bude recimo u koloni G ili H ili nebotno, samo da je jedno ispod drugog
evo ovako

H
B2:B7 - opseg1
C2:C7 - opseg2
D2:D7 - opseg3
E2:E7 - opseg4

ovo je primer tabela koju sam okacio a ustvari se radi o mnogo vise podataka i opsega, gde ima na primer opseg od B2:B200
ali od B2 do neke celije ima rezultat a od te celije do B200 su prazne celije koje ne treba kopirati.

kroz pretragu sam naisao na kod koji je postavio @elektroing http://www.elitesecurity.org/t471755-0
on mi nije resio problem ali cinimi se da je najblizi od svih koje sam uspeo da pronadjem
dali neko zna kako treba modifikovati ovaj kod ili bilo ko ko ima kakvo resenje

sve ce ovo jednom proci

Prikačeni fajlovi

Proba2.xls - 457k

Odgovor na temu

Dexxxl

Profil

Re: Vise opsega iskopirane u jednoj koloni

^{22.03.2018. u 19:13 - pre 73 meseci}

Dim I As Integer
Dim j As Integer

Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
j = Selection.Cells.Count - 1

For I = 0 To j
Range("B2").Select
ActiveCell.Offset(0, I).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("I8").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Next I

Vrlo je bitno da u celiji I8 (ili gde vec kopiras), kao i celiji ispod nje I9 prvo upises nesto, samo da ne budu prezne

Odgovor na temu

inzenjerija
inzenjer
sta dodje pod ruku
Tutin

Član broj: 336351
Poruke: 48
*.static.isp.telekom.rs.

+1 Profil

Re: Vise opsega iskopirane u jednoj koloni

^{23.03.2018. u 07:05 - pre 73 meseci}

Hvala ti @Dexxxl ovo je tacno ono za sta sam postavio pitanje

ali sam ja pogresno naveo primer. u mojim tabelama bas gde treba da ubacim kod ima razmaka izmedju kolona.
recimo rang F2:F200,M2:M200,T2:T200 i zavrsava kod ranga LI2:L200
Znaci preskace 6 kolona pa rang. pokusao sam sa ovim kodom da odradim ali bezuspesno
Izvinjavam se jos jednom

sve ce ovo jednom proci

Odgovor na temu

Dexxxl

Profil

Re: Vise opsega iskopirane u jednoj koloni

^{23.03.2018. u 12:29 - pre 73 meseci}

Postavi u neki modul funkciju

Code:

Function traziZadnjuKolonu(ImeSita As String) As Integer
    Dim Zadnji As Long
    Dim ws As Worksheet
    Dim zadnjaCelija As Range

    Set ws = Sheets(ImeSita)

    Set zadnjaCelija = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, _
                                    LookAt:=xlPart, SearchOrder:=xlByColumns, _
                                    SearchDirection:=xlPrevious, MatchCase:=False)

    Zadnji = zadnjaCelija.Column
    traziZadnjuKolonu = Zadnji
End Function

Onda kod iz prethodnog posta zameni sa

Code:

Dim I As Integer
Dim j As Integer

Dim ime As String
Dim zadnja As Integer
Dim c As Integer

ime = Application.ActiveSheet.Name
zadnja = traziZadnjuKolonu(ime)
Range("B2").Select 'celija odakle ti pocinje oblast
c = ActiveCell.Column
Range(Selection, Selection.End(xlToRight)).Select
j = zadnja - c + 1

For I = 0 To j Step 7
    Range("B2").Select  'celija odakle ti pocinje oblast
    ActiveCell.Offset(0, I).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("H2").Select  'celija gde kopiras, mora da pise nesto u njoj, kao i u celiji ispod nje
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    Next I

Inace funkciju za nalazenje zadnje popunjene kolone sam skinuo sa
http://www.icentar.ba/showtopic.php?id=6342

Odgovor na temu

Dexxxl

Profil

Re: Vise opsega iskopirane u jednoj koloni

^{23.03.2018. u 12:36 - pre 73 meseci}

ps

ispod
c = ActiveCell.Column

obrisi
Range(Selection, Selection.End(xlToRight)).Select
nepotrebno je, zaostalo izprethodne funkcije

Odgovor na temu

inzenjerija
inzenjer
sta dodje pod ruku
Tutin

Član broj: 336351
Poruke: 48
*.static.isp.telekom.rs.

+1 Profil

Re: Vise opsega iskopirane u jednoj koloni

^{23.03.2018. u 13:24 - pre 73 meseci}

Nesto izgleda da preskacem u uputstvu koje si mi dao

nabacit cu tabelu o kojoj sam pricao
sve se vrti oko kopiranja rang F2:F200,M2:M200,T2:T200 i zavrsava kod ranga MK2:MK200
da sve rangove pocev od F2:F200 do MK2:MK200 iskopira u koloni MM

sve ce ovo jednom proci

Prikačeni fajlovi

ISCRTAVANJE ZGRADE-VISE.xlsm - 588.35k

Odgovor na temu

Dexxxl
Dejan Stojanovic
Blagi uzas
Knjazevac

Član broj: 252836
Poruke: 212
178-220-228-72.dynamic.isp.telekom.rs.

+9 Profil

Re: Vise opsega iskopirane u jednoj koloni

^{23.03.2018. u 17:24 - pre 73 meseci}

Uf!!! Problem je sto su kod tebe formule. Pre makroa za kopiranje treba da ocistis celije gde nema vrednosti (Makro ciscenje). Ako zelis da sacuvas originalne podatke radi ovo na kopiji (Sheet1 (2) u mom primeru)

Prikačeni fajlovi

ISCRTAVANJE ZGRADE Dex.xlsm - 1335.95k

Odgovor na temu

inzenjerija
inzenjer
sta dodje pod ruku
Tutin

Član broj: 336351
Poruke: 48
*.dynamic.isp.telekom.rs.

+1 Profil

Re: Vise opsega iskopirane u jednoj koloni

^{24.03.2018. u 10:17 - pre 73 meseci}

Uspelo je @Dexxxl hvala ti puno

sve ce ovo jednom proci

Odgovor na temu