excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Zkopírování rozsahu buňek a posun pod ně
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
MS Excel
Téma: Zkopírování rozsahu buňek a posun pod ně 
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
(16.10.2017 17:02)#037976
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
https://drive.google.com/open?id=0B-1Ogm5IVnqUSVhGN1RpT0tNQW8
sorry nevim jak se vkládají přílohy :D tak jsem to hodil na drivecitovat
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).ClearContentscitovat
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).ClearContentscitovat
(25.10.2017 20:20)#038137
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
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
(30.10.2017 11:50)#038183
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
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
(31.10.2017 12:00)#038202
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.
(31.10.2017 20:28)#038212
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
38226_se_it1.zipUživatelské menu
Nejste přihlášen(a)
\n
\nMenu
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.
RSS nejnovější články