Note: The other languages of the website are Google-translated. Back to English
English English

Jak vytvořit příkazové tlačítko pro kopírování a vkládání dat v aplikaci Excel?

Předpokládejme, že po změně dat budete muset často kopírovat řadu buněk na jiné místo, metoda ručního kopírování a vkládání bude náročná a časově náročná. Jak zajistit, aby tato záležitost kopírování a vkládání probíhala automaticky? Tento článek vám ukáže, jak pomocí příkazového tlačítka zkopírovat a vložit data pouze jedním kliknutím.

Vytvořte příkazové tlačítko pro kopírování a vkládání dat pomocí kódu VBA


Vytvořte příkazové tlačítko pro kopírování a vkládání dat pomocí kódu VBA

Při automatickém kopírování a vkládání dat po kliknutí na příkazové tlačítko postupujte následovně.

1. Vložte příkazové tlačítko kliknutím Vývojka > Vložit > Příkazové tlačítko (ovládání ActiveX). Viz snímek obrazovky:

2. Nakreslete do listu příkazové tlačítko a klikněte na něj pravým tlačítkem. Vybrat Zobrazit kód z kontextové nabídky.

3. Ve vyskakovacím okně Microsoft Visual Basic pro aplikace v okně Kód prosím nahraďte původní kód v okně Kód níže uvedeným kódem VBA.

Kód VBA: Pomocí příkazového tlačítka zkopírujte a vložte data do aplikace Excel

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim xSheet As Worksheet
    Set xSheet = ActiveSheet
        If xSheet.Name <> "Definitions" And xSheet.Name <> "fx" And xSheet.Name <> "Needs" Then
            xSheet.Range("A1:C17 ").Copy
            xSheet.Range("J1:L17").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If

    Application.ScreenUpdating = True
End Sub

Poznámka: V kódu je CommandButton1 název vloženého příkazového tlačítka. A1: C17 je rozsah, který potřebujete zkopírovat, a J1: L17 je cílový rozsah pro vložení dat. Změňte je prosím podle potřeby.

4. lis Další + Q klávesy pro zavření Microsoft Visual Basic pro aplikace okno. A vypněte režim návrhu na kartě Vývojář.

5. Nyní klikněte na příkazové tlačítko, všechna data v rozsahu A1: C17 budou zkopírována a vložena do rozsahu J1: L17 bez formátování buňky.


Související články:


Nejlepší kancelářské nástroje produktivity

Kutools pro Excel řeší většinu vašich problémů a zvyšuje vaši produktivitu o 80%

  • Opakované použití: Rychle vložte složité vzorce, grafy a cokoli, co jste dříve používali; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
  • Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
  • Sloučit buňky / řádky / sloupce bez ztráty dat; Rozdělit obsah buněk; Zkombinujte duplicitní řádky / sloupce... Zabraňte duplicitním buňkám; Porovnat rozsahy...
  • Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
  • Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
  • Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
  • Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
  • Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
  • Více než 300 výkonných funkcí. Podporuje Office / Excel 2007-2019 a 365. Podporuje všechny jazyky. Snadné nasazení ve vašem podniku nebo organizaci. Kompletní funkce 30denní bezplatná zkušební verze. 60denní záruka vrácení peněz.
karta kte 201905

Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50% a omezuje stovky kliknutí myší každý den!
officetab dno
Komentáře (58)
Hodnocení 4.5 z 5 · 1 hodnocení:
Tento komentář byl moderátorem webu minimalizován
Tuto funkci jsem použil ve svém sešitu. Používám aktivní tlačítka x ke kopírování a vkládání dat ze stejného listu na více listů. Existují však listy bez aktivních tlačítek x nebo maker, které vkládají data z příslušných polí na listu, což nechci. Pomoc?
Tento komentář byl moderátorem webu minimalizován
Mohu mít kód, který zkopíruje rozsah I4:L26 z List2 (nazývaného TransferSheet) (tlačítko bude na tomto listu) do Listu1 (nazvaného JobsToDo) na řádku C (první řádek, který je prázdný, protože do něj budou neustále přidávána data, prosím
Tento komentář byl moderátorem webu minimalizován
Jak můžete změnit kód pro vložení výsledků na jinou stránku v sešitu? a jak vložíte řádek před vložením nových dat, aby je nepřepsal
Tento komentář byl moderátorem webu minimalizován
Ahoj Jason,
Pokud chcete výsledky vložit do jiných listů v sešitu, zkuste níže uvedený kód VBA.

Private Sub CommandButton1_Click ()
Dim xSheet, xDWS jako pracovní list
Dim xFNum jako celé číslo
Dim xSRg jako rozsah

On Error Resume Next
Set xSRg = Application.InputBox("Vyberte buňku pro vložení rozsahu:", "Kutools pro Excel", xTxt, , , , , 8)
Pokud xSRg není nic, pak Exit Sub

Application.ScreenUpdating = False
Range("A1:C17 ").Kopírovat
xSRg.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.ScreenUpdating = True

End Sub
Tento komentář byl moderátorem webu minimalizován
jaký je vzorec pro kopírování souborů
pak jej vložte na další list. a vložte další, vytvořte mezeru nebo pokračujte dolů, aniž byste smazali předchozí vložení.
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Níže uvedený kód VBA vám může pomoci vyřešit problém. Zkuste to prosím. Děkuji.

Private Sub CommandButton1_Click ()
Dim xSheet, xDWS jako pracovní list
Dim xFNum jako celé číslo
Dim xSRg jako rozsah

On Error Resume Next
Set xSRg = Application.InputBox("Vyberte buňku pro vložení rozsahu:", "Kutools pro Excel", xTxt, , , , , 8)
Pokud xSRg není nic, pak Exit Sub

Application.ScreenUpdating = False
Range("A1:C17 ").Kopírovat
xSRg.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.ScreenUpdating = True

End Sub
Tento komentář byl moderátorem webu minimalizován
Co když si chci vytvořit frontu na vložení?
Abych dále vysvětlil. Kliknu na CommandButton1 a poté zkopíruji A1. Když jsem použil vložit, kopii z A1 - Poté chci zkopírovat A2 bez kliknutí na další tlačítko, abych mohl A2 vložit hned někam jinam. Potom Když jsem použil vložit, zkopírujte z A2 a poté zkopírujte A3. Pokud je to možné? Může to také fungovat na pozadí, když používám normální list aplikace Excel a zkuste provést tuto akci, kde zkopíruji z aplikace Excel a poté vložím do úplně jiného programu, jako je internetový prohlížeč, jiný program, word, soubor txt a tak dále ?

Tento článek byl každopádně velmi užitečný, děkuji mnohokrát!
Tento komentář byl moderátorem webu minimalizován
Ahoj Magnusi,
S tím vám bohužel nepomůžu. Děkuji za Váš komentář.
Tento komentář byl moderátorem webu minimalizován
Chtěl bych tento jeden krok rozšířit... Po vložení skutečných hodnot, nikoli vzorců... Potřebuji zkopírovat novou buňku a vložit ji do jiného programu, který není excel, měl bych jednoduše kliknout na tlačítko zkopírovat vzorec z konkrétní buňku a vložte skutečnou hodnotu do jiné, poté zkopírujte tuto novou hodnotu do schránky Windows do minulosti v jiné aplikaci. Doufám, že to dává smysl a oceňuji vaši pomoc, když víte, jak přidat nový kód... Vím, co chci, aby to dělalo, jen nevím, jak to kódovat...
Díky
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Kód byl v článku aktualizován, zkuste to prosím. Děkuji za váš komentář.
Tento komentář byl moderátorem webu minimalizován
Bylo by možné, aby příkazové tlačítko okamžitě vložilo vybraný rozsah do určeného listu (do další prázdné buňky), místo aby bylo nutné pokaždé zadávat, kam chcete vložit data?
Tento komentář byl moderátorem webu minimalizován
Ahoj Adam,
Níže uvedený kód VBA vám může pomoci vyřešit problém.
Musíte nahradit "Sheet4" a "A1:C17" v kódu vámi zadaným listem a rozsahem.

Private Sub CommandButton1_Click ()
Dim xSWName jako řetězec
Dim xSheet As Worksheet
Dim xPSheet As Worksheet
Dim xIntR jako celé číslo
xSWName = "List4"
On Error Resume Next
Application.ScreenUpdating = False
Nastavit xSheet = ActiveSheet
Pokud xSheet.Name <> "Definice" a xSheet.Name <> "fx" A xSheet.Name <> "Potřebuje" Pak
xSheet.Range("A1:C17 ").Kopírovat
Set xPSheet = Worksheets.Item(xSWName)
xIntR = xPSheet.UsedRange.Rows.count
xPSheet.Cells(xIntR + 1, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Application.ScreenUpdating = True
End Sub
Tento komentář byl moderátorem webu minimalizován
velmi dobré , potřebuji kopírovat a vkládat mnohokrát , je možné zvolit vložení řádku dat do 3 řádků nebo 5 řádků , co se mi líbí ?
Tento komentář byl moderátorem webu minimalizován
S tím vám bohužel nepomůžu
Tento komentář byl moderátorem webu minimalizován
pane, jak zkopírovat rozsah buňky v aktuálním listu a poté vložit do jiného listu?
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Níže uvedený kód VBA vám může pomoci vyřešit problém.
Musíte nahradit "Sheet4" a "A1:C17" v kódu vámi zadaným listem a rozsahem.

Private Sub CommandButton1_Click ()
Dim xSWName jako řetězec
Dim xSheet As Worksheet
Dim xPSheet As Worksheet
Dim xIntR jako celé číslo
xSWName = "List4"
On Error Resume Next
Application.ScreenUpdating = False
Nastavit xSheet = ActiveSheet
Pokud xSheet.Name <> "Definice" a xSheet.Name <> "fx" A xSheet.Name <> "Potřebuje" Pak
xSheet.Range("A1:C17 ").Kopírovat
Set xPSheet = Worksheets.Item(xSWName)
xIntR = xPSheet.UsedRange.Rows.count
xPSheet.Cells(xIntR + 1, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Application.ScreenUpdating = True
End Sub
Tento komentář byl moderátorem webu minimalizován
Pokud to chci zkopírovat ne do aktuálního sešitu, ale do jiného sešitu (který stále není otevřen) v aplikaci Excel. Jak odpovídajícím způsobem změním tento kód VBA?
Tento komentář byl moderátorem webu minimalizován
Ahoj Robberte,
S tím vám bohužel nepomůžu. Děkuji za komentář.
Tento komentář byl moderátorem webu minimalizován
Mám qusrion Mám list 1 se sloupcem data b3:b33 a chci, aby byl zkopírován na list 2 B33:b63 jeho text, ale potřebuji stejný formát pro text, tj. velikost barvy
Tento komentář byl moderátorem webu minimalizován
Ahoj autore,

Článek, který jste uvedl výše, je pro mě velmi užitečný. Nejsem zvyklý na excelový kód a příkazy. Pořád to potřebuji vědět spíše než tento článek. Jsem v pořádku s kopírováním a vkládáním na další list. Ale stále potřebuji vědět, "jak vložit a přidat do nového řádku v dalším listu pokaždé, když stisknu tlačítko". Jinak budou moje data na dalším listu pokaždé nahrazena. Byl bych vám opravdu vděčný a těším se na vaši odpověď.
Tento komentář byl moderátorem webu minimalizován
Ahoj Kyaw Ye Min,
Omlouvám se, že odpovídám tak pozdě. Postupujte podle kroků a nahraďte kód níže uvedeným. V kódu je List4 cílový list, do kterého budete kopírovat data, změňte jej a zkopírovaný rozsah A1:C17 podle potřeby. Děkuji za Váš komentář.

Private Sub CommandButton1_Click ()
Dim xSWName jako řetězec
Dim xSheet As Worksheet
Dim xPSheet As Worksheet
Dim xIntR jako celé číslo
xSWName = "List4"
On Error Resume Next
Application.ScreenUpdating = False
Nastavit xSheet = ActiveSheet
Pokud xSheet.Name <> "Definice" a xSheet.Name <> "fx" A xSheet.Name <> "Potřebuje" Pak
xSheet.Range("A1:C17 ").Kopírovat
Set xPSheet = Worksheets.Item(xSWName)
xIntR = xPSheet.UsedRange.Rows.Count
xPSheet.Cells(xIntR + 1, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Application.ScreenUpdating = True
End Sub
Tento komentář byl moderátorem webu minimalizován
Dobrý den, prosím o pomoc. Požaduji totéž jako výše, ale potřebuji pouze vložit cokoli, co je aktivní buňka, do nového řádku (pokud možno nad předchozí položky) v jiném listu. Opravdu oceňuji jakoukoli pomoc s tímto. S pozdravem
Tento komentář byl moderátorem webu minimalizován
ahoj, pomozte s mým případem, chci mít tlačítko pro vygenerování makra tam, kde mám excel a exportovat data, kde v <" "> do wordu, díky
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Omlouvám se, že jsem nepochopil vaši pointu. Bylo by hezké, kdybyste mohli vysvětlit více podrobností o tom, co se snažíte dělat.
Tento komentář byl moderátorem webu minimalizován
Hledám nějakou nápovědu k tomu, že uživatel může kliknout na číslo řádku a poté stisknout příkazové tlačítko, že vytvoří kopii tohoto řádku a vloží jej do řádku pod ním.
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Sorry ti s tím ještě může pomoci. Děkuji za Váš komentář.
Tento komentář byl moderátorem webu minimalizován
mistr bagaimana jika berbeda list dan kopie dat yg diinginkan
contoh sheet1 hanya data kolem B & kolem D copy ke sheet2
terimakasih
Tento komentář byl moderátorem webu minimalizován
odešlete kód VBA pro zkopírování obsahu jedné buňky pomocí kliknutí na tlačítko příkazu bez použití textového pole, abyste je mohli vložit do jakékoli aplikace, jako je poznámkový blok, msword
Tento komentář byl moderátorem webu minimalizován
Je možné vytvořit tlačítko, které pouze zkopíruje jednu vybranou buňku na jednom listu na jiný list? Dík!
Tento komentář byl moderátorem webu minimalizován
ahoj lexi,
Níže uvedený kód VBA vám může pomoci vyřešit problém. Změňte prosím "Sheet3" na název listu, jak potřebujete.
Vyberte buňku a stiskněte příkazové tlačítko, aby to fungovalo.

Private Sub CommandButton1_Click ()
Dim xSWName jako řetězec
Dim xSheet As Worksheet
Dim xPSheet As Worksheet
Dim xIntR jako celé číslo
xSWName = "List3"
On Error Resume Next
Application.ScreenUpdating = False
Nastavit xSheet = ActiveSheet
Pokud xSheet.Name <> "Definice" a xSheet.Name <> "fx" A xSheet.Name <> "Potřebuje" Pak
Selection.CurrentRegion.Select
Selection.Copy
Set xPSheet = Worksheets.Item(xSWName)
xIntR = xPSheet.UsedRange.Rows.Count
xPSheet.Cells(xIntR + 1, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Application.ScreenUpdating = True
End Sub
Tento komentář byl moderátorem webu minimalizován
Dobrý den!
Existuje způsob, jak vytvořit kód, abych mohl pomocí tlačítka zkopírovat rozsah (řekněme A1: D5).
A pak to vložte do A6:D10.

A pokud stisknu tlačítko ještě jednou, zkopíruje se A1:D5 do A11:D15.

A tak dále?
Tento komentář byl moderátorem webu minimalizován
Ahoj Jonas,
S tím vám bohužel nepomůžu. Děkuji za váš komentář.
Tento komentář byl moderátorem webu minimalizován
To je skvělé - přizpůsobil jsem se svému s.sheetu, ale potřebuji, aby byl dynamičtější a používal spíše štítky než pevné kódování umístění buněk.
Tj. v rozsahu A2-A6 najděte jméno 'Jamie' a pak najděte jméno ve sloupci K2 a vložte

Potřebuji také každé kliknutí na +1 a spuštění stejného kopírování a vkládání, ale do dalšího sloupce, tzn

click 1 - vloží do Q1, Click 2 - vloží do Q2 atd

Příklad:

Sloupec A Sloupec B ...... Sloupec K Sloupec L
1. Jméno Odpracovaná hodina Jméno Q1 Q2 Q3 Q4
2. Jamie 22 Sammy
3. Sammy 40 Judith
4. Judith 18 Jamie
5. Tammy 16 Keith
6. Keith 42 Tammy


Jakákoli pomoc by byla velmi oceněna.
Tento komentář byl moderátorem webu minimalizován
jak kódovat pro kopírování buňky z rozsahu a1 až a5 pro vložení do c1 a do další dostupné buňky postupně?
Tento komentář byl moderátorem webu minimalizován
a také zkopírujte a vložte buňku jednu po druhé..
Děkujeme vám za vaši pomoc!
Tento komentář byl moderátorem webu minimalizován
Ahoj kluci. potřebuje to pomoc, prosím. Potřebuji vytvořit 10* tlačítko v mém listu (Sheet1), které zkopíruje 3 buňky, Příklad: Sheet1, A1, B1, C1. pak to vložte do Listu 2 A1, B1, C1. pak když kliknu na tlačítko 4, příklad: List1, A4, B4, C4, musím to vložit do Listu2, A2, B2, C2. Pokud kliknu na tlačítko 2, musí projít v List2, A3, B3, C3. Doufám, že to dává smysl.
Zatím zde nejsou žádné komentáře
Načíst další
Zanechat své připomínky
Odesílání jako host
×
Ohodnoťte tento příspěvek:
0   Postavy
Doporučená umístění