< návrat zpět

MS Excel


Téma: Zkopírování rozsahu buňek a posun pod ně rss

Zaslal/a 15.10.2017 13:01

Zdravim, potřeboval bych poradit, jak napsat makro tak abych když zmáčknu na tlačítko zkopírovalo část tabulky a nakopírovala se pod stávající tabulku.

Děkuji mockrát, zkoušel jsem to přes offset, ale tak nějak jsem se do toho zamotal. že nevím jak na to :/

Mockrát děkuji za pomoc

Jméno
Kontrola
Text
  b i u s img code url hr   1 2 3 4 5 6 7 8 9 10

#037974
Jeza.m
Chtělo by to přílohu.
Čím je definována část tabulky jenž se má kopírovat?

M@citovat
#037976
avatar
Zde je příloha. Měla by se pomocí tlačítka vkládat tabulka od "Th až KO za", ale jen prázdná (jelikož v ní bude poté text). pod stávající "Th až KO za".
https://drive.google.com/open?id=0B-1Ogm5IVnqUSVhGN1RpT0tNQW8

sorry nevim jak se vkládají přílohy :D tak jsem to hodil na drivecitovat
#037977
Jeza.m
Tak třeba takhle nějak ...

Dim rd As Single
Dim rdk As Single
rd = 23

Do While Cells(rd, 2) <> "KO za:"
rd = rd + 1
If Cells(rd, 2) = "KO za:" And rdk = 0 Then rdk = rd
If Cells(rd, 2) = "KO za:" And Cells(rd + 1, 2) <> "" Then rd = rd + 1
Loop

Range("B23:F" & rdk).Copy Range("B" & rd + 1)
Range("C" & rd + 1 & ":F" & rd + 17).ClearContents
citovat
#037978
avatar
Díky moc to je přesně ono :)citovat
#038137
avatar
ahoj mohl bys mi to to přetvořit znova :/ třeba i s popisem toho kódu k pochopení snažil jsem se ho nějak upravit ale nějak to nevyšlo :/

tady posílám upravený soubor potřeboval bych udělat opět to samé ale od řádku 22 po řádek 28. Díky moc to je snad naposled
https://drive.google.com/open?id=0B-1Ogm5IVnqUOV9fbWtDWTRPNVkcitovat
#038183
avatar
Dim rd As Single
Dim rdk As Single

rd = 23 'nastav proměnnou rd na 23 řádek

Do While Cells(rd, 2) <> "KO za:" 'jdi řádek po řádku počínaje tím 23 dokud nenarazíš na text "KO za:" ve sloupci 2

rd = rd + 1 'zkus další řádek

If Cells(rd, 2) = "KO za:" And rdk = 0 Then rdk = rd 'Je-li ve sloupci 2 daného řádku "KO za:" a rdk = 0 tak zapiš do rdk aktuální řádek - bude sloužit jako koncový řádek výběru.

If Cells(rd, 2) = "KO za:" And Cells(rd + 1, 2) <> "" Then rd = rd + 1 'pokud pod buňkou s textem "KO za:" je buňka s textem, tak pokračuj na další řádek

Loop

Range("B23:F" & rdk).Copy Range("B" & rd + 1) 'Zkopíruj oblast B23:F a koncový řádek do buňky B a následující řádek

Range("C" & rd + 1 & ":F" & rd + 17).ClearContents 'V nové oblasti ve sloupcích C:F vymaž obsah.citovat
#038202
avatar

mm napsal/a:

Dim rd As Single
Dim rdk As Single

rd = 23 'nastav proměnnou rd na 23 řádek

Do While Cells(rd, 2) <> "KO za:" 'jdi řádek po řádku počínaje tím 23 dokud nenarazíš na text "KO za:" ve sloupci 2

rd = rd + 1 'zkus další řádek

If Cells(rd, 2) = "KO za:" And rdk = 0 Then rdk = rd 'Je-li ve sloupci 2 daného řádku "KO za:" a rdk = 0 tak zapiš do rdk aktuální řádek - bude sloužit jako koncový řádek výběru.

If Cells(rd, 2) = "KO za:" And Cells(rd + 1, 2) <> "" Then rd = rd + 1 'pokud pod buňkou s textem "KO za:" je buňka s textem, tak pokračuj na další řádek

Loop

Range("B23:F" & rdk).Copy Range("B" & rd + 1) 'Zkopíruj oblast B23:F a koncový řádek do buňky B a následující řádek

Range("C" & rd + 1 & ":F" & rd + 17).ClearContents 'V nové oblasti ve sloupcích C:F vymaž obsah.
tady je ten aktualizovany soubor :/ https://docs.google.com/spreadsheets/d/1tFfUrex6ctH9-00B2YucIhwIfpLUQzIXTGZoOi22S80/edit?usp=drivesdk ted tam mam 2 prazdne radky, jakpa na ne odkazi :/ Diky moc :/citovat
#038212
avatar
Dobrý upravil jsem to tak, že se mi to zkopíruje jednou, ale pak se furt dokola přemazává ta nově zkopírovaná část. :(citovat
#038226
Jeza.m
příklad v příloze.

M@
Příloha: zip38226_se_it1.zip (180kB, staženo 29x)
citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje