Vise opsega iskopirane u jednoj koloni

[ inzenjerija @ 22.03.2018. 16:22 ] @

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

[ @ 22.03.2018. 19:13 ] @

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

[ inzenjerija @ 23.03.2018. 07:05 ] @

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

[ @ 23.03.2018. 12:29 ] @

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

[ @ 23.03.2018. 12:36 ] @

ps

ispod
c = ActiveCell.Column

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

[ inzenjerija @ 23.03.2018. 13:24 ] @

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

[ Dexxxl @ 23.03.2018. 17:24 ] @

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)

[ inzenjerija @ 24.03.2018. 10:17 ] @

Uspelo je @Dexxxl hvala ti puno