Przejdź do głównej zawartości

Jak utworzyć przycisk polecenia, aby skopiować i wkleić dane w programie Excel?

Przypuśćmy, że po zmianie danych trzeba często kopiować zakres komórek w inne miejsce, ręczna metoda kopiowania i wklejania będzie trudna i czasochłonna. Jak sprawić, by ta sprawa kopiowania i wklejania działała automatycznie? W tym artykule dowiesz się, jak używać przycisku polecenia do kopiowania i wklejania danych jednym kliknięciem.

Utwórz przycisk polecenia, aby skopiować i wkleić dane za pomocą kodu VBA


Utwórz przycisk polecenia, aby skopiować i wkleić dane za pomocą kodu VBA

Wykonaj następujące czynności, aby automatycznie kopiować i wklejać dane po kliknięciu przycisku polecenia.

1. Wstaw przycisk polecenia, klikając Deweloper > wstawka > Przycisk polecenia (formant ActiveX). Zobacz zrzut ekranu:

2. Narysuj przycisk polecenia w arkuszu i kliknij go prawym przyciskiem myszy. Wybierz Wyświetl kod z menu kontekstowego.

3. W wyskakującym okienku Microsoft Visual Basic for Applications oknie, zamień oryginalny kod w oknie Kod na poniższy kod VBA.

Kod VBA: użyj przycisku polecenia, aby skopiować i wkleić dane w programie 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

Note: W kodzie CommandButton1 to nazwa wstawionego przycisku polecenia. A1: C17 to zakres, który musisz skopiować, a J1: L17 to zakres docelowy do wklejenia danych. Zmień je według potrzeb.

4. naciśnij inny + Q klucze do zamknięcia Microsoft Visual Basic for Applications okno. I wyłącz tryb projektowania na karcie Deweloper.

5. Teraz kliknij przycisk polecenia, wszystkie dane z zakresu A1: C17 zostaną skopiowane i wklejone do zakresu J1: L17 bez formatowania komórki.


Powiązane artykuły:

Najlepsze narzędzia biurowe

🤖 Pomocnik AI Kutools: Zrewolucjonizuj analizę danych w oparciu o: Inteligentne wykonanie   |  Wygeneruj kod  |  Twórz niestandardowe formuły  |  Analizuj dane i generuj wykresy  |  Wywołaj funkcje Kutools...
Popularne funkcje: Znajdź, wyróżnij lub zidentyfikuj duplikaty   |  Usuń puste wiersze   |  Łącz kolumny lub komórki bez utraty danych   |   Okrągły bez wzoru ...
Super wyszukiwanie: Wiele kryteriów VLookup    Wiele wartości VLookup  |   Przeglądanie pionowe na wielu arkuszach   |   Wyszukiwanie rozmyte ....
Zaawansowana lista rozwijana: Szybko twórz listę rozwijaną   |  Zależna lista rozwijana   |  Lista rozwijana wielokrotnego wyboru ....
Menedżer kolumn: Dodaj określoną liczbę kolumn  |  Przesuń kolumny  |  Przełącz stan widoczności ukrytych kolumn  |  Porównaj zakresy i kolumny ...
Polecane funkcje: Fokus siatki   |  Widok projektu   |   Duży pasek formuły    Menedżer skoroszytów i arkuszy   |  Biblioteka zasobów (Automatyczny tekst)   |  Selektor dat   |  Połącz arkusze   |  Szyfruj/odszyfruj komórki    Wysyłaj e-maile według listy   |  Super filtr   |   Specjalny filtr (filtruj pogrubienie/kursywa/przekreślenie...) ...
15 najlepszych zestawów narzędzi12 Tekst Tools (Dodaj tekst, Usuń znaki, ...)   |   50 + Wykres rodzaje (Wykres Gantta, ...)   |   40+ Praktyczne Wzory (Oblicz wiek na podstawie urodzin, ...)   |   19 Wprowadzenie Tools (Wstaw kod QR, Wstaw obraz ze ścieżki, ...)   |   12 Konwersja Tools (Liczby na słowa, Przeliczanie walut, ...)   |   7 Połącz i podziel Tools (Zaawansowane wiersze łączenia, Podział komórki, ...)   |   ... i więcej

Zwiększ swoje umiejętności Excela dzięki Kutools for Excel i doświadcz wydajności jak nigdy dotąd. Kutools dla programu Excel oferuje ponad 300 zaawansowanych funkcji zwiększających produktywność i oszczędzających czas.  Kliknij tutaj, aby uzyskać funkcję, której najbardziej potrzebujesz...

Opis


Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę

  • Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
  • Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
  • Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!
Comments (61)
Rated 4.5 out of 5 · 2 ratings
This comment was minimized by the moderator on the site
hello! have good day. i have a problem plz anyone could helpme. i have a data in my excel sheet. it has three types Plaining, Release and archive. I need a code such that when i click on Release the entire row cut from active sheet and pasted to another sheet i-e Released PR's. similarly when i click on archive the entire row cut from active PR's to Archived PR's sheet. i will be thank full if anyone help me as soon as possible.
Rated 4.5 out of 5
This comment was minimized by the moderator on the site
Hola, este mismo codigo funciona con power point? Pregunto por que necesito copiar y pegar la información de una diapositiva a otra. Muchas gracias.
This comment was minimized by the moderator on the site
Hi Ivan,
We only provide VBA scripts for Microsoft Excel, Word and Outlook. This VBA script does not apply to PowerPoint. Sorry for the inconvenience.
This comment was minimized by the moderator on the site
Cảm ơn bạn
Rated 4.5 out of 5
This comment was minimized by the moderator on the site
Cara, eu preciso copiar determinado dados, que são gerados todos os dias, mas salvos em planilhas diferentes, eu já criei a macro e salvei na PERSONAL, para conseguir usar em todas planilhas que abrir, mas não estou conseguindo colocar o código pra ele pegar esses dados, que se localizam sempre na mesma linha e coluna, ele sempre pega da planilha que eu realizei a macro, consegue me ajudar com isso ? Seria um código que sempre pega da planilha atual, aberta, e não da qual eu gravei a macro
This comment was minimized by the moderator on the site
Hi Gabriel,
If you need to copy data in different worksheets each time, you do not need to run the code with a command button.
After pressing the Alt + F11 keys to open the Basic Visual editor, click Insert > Module, and then copy the following VBA code into the Module (Code) window.
To copy data in any worksheet, you just need to open the worksheet, click Develper > macros to open the Macro window, select the macro name "CopyData" and then click the Run button to run the code.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/copy_data.png

Sub CopyData()
    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
This comment was minimized by the moderator on the site
Hello,

I'm currently at using the following code:


Private Sub CommandButton1_Click()
Dim xSWName As String
Dim xSheet As Worksheet
Dim xPSheet As Worksheet
Dim xIntR As Integer
xSWName = "Aktiva"
On Error Resume Next
Application.ScreenUpdating = False
Set xSheet = ActiveSheet
If xSheet.Name <> "Definitions" And xSheet.Name <> "fx" And xSheet.Name <> "Needs" Then
xSheet.Range("A6:F60 ").Copy
Set xPSheet = Worksheets.Item(xSWName)
xPSheet.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Application.ScreenUpdating = True
End Sub


But I would it to copy the text to the next empty cell, currently it just pastes it at the top and overwrites what's currently there.
Can someone help me, so that when I use this "script/marco" it goes to the next possible empty space?

Thanks in advance,
Calle
This comment was minimized by the moderator on the site
Hi Calle,
Do you want to fill blank cells with value above in a certian range in Excel?
If so, perhaps the methods in this post can do you a favor.
How To Fill Blank Cells With Value Above / Below / Left / Right In Excel?
If I am not understanding correctly, please attach a screenshot of your data to describe it more clearly.
This comment was minimized by the moderator on the site
Please excuse me, I found my omission...

On the other hand, this soul generates a mail per recipient whereas I wish to write a single email (grouped) to all the recipients. I can't find what to change...
Could you help me in solving this problem please?

Thank you again for your help,
Cordially. Have a good day.
This comment was minimized by the moderator on the site
Hi Clément,
To avoid this error "Dim xOutApp As Outlook.Application" -> Undefined user-defined type, you need to check the Microsoft Outlook 16.0 Object Library box as shown in the screenshot above.
The above VBA code helps to create a separate email to each recipient listed in cells.
If you want to create a single email with all email addresses displayed in the Recipients field (see screenshot below), the following VBA code can help you to do it.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/button_email.png
Private Sub CommandButton1_Click()
'updateby Extendoffice 20220901
    Dim xOTApp As Object
    Dim xMItem As Object
    Dim xCell As Range
    Dim xRg As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Range("A1:A3")
    If xRg Is Nothing Then Exit Sub
    Set xOTApp = CreateObject("Outlook.Application")
    For Each xCell In xRg
        If xCell.Value Like "*@*" Then
            If xEmailAddr = "" Then
                xEmailAddr = xCell.Value
            Else
                xEmailAddr = xEmailAddr & ";" & xCell.Value
            End If
        End If
    Next
    Set xMItem = xOTApp.CreateItem(0)
    With xMItem
        .To = xEmailAddr
        .Subject = "Test"
        .Body = "Dear " _
                & vbNewLine & vbNewLine & _
                "This is a test email " & _
                "sending in Excel"
        .Display
    End With
End Sub
This comment was minimized by the moderator on the site
Thanks !
I made it but I have an error on this line : "Dim xOutApp As Outlook.Application" -> Undefined user-defined type

I don't understand because I made steps described in your message... Can you help me again please ? :-/


Thanks a lot !
This comment was minimized by the moderator on the site
Hi there ! Great page, very practical for me... !
Is it posible to copy datas (a list of mails) and paste it directly in "recipients" on Outlook ? If it's possible, I don't know how to do it...

Can you help me please ?
This comment was minimized by the moderator on the site
Hi Clement,
If you want to click a button then copy a list of email addresses and paste them directly in the "To" field in Outlook. The following VBA code can help.
After adding the code, please click Tools > Reference, then check the Microsoft Outlook 16.0 Object Library box.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/outlook_object_library.png

Private Sub CommandButton1_Click()
'Updated by Extendoffice 20220831
    Dim xRg As Range
    Dim xRgEach As Range
    Dim xRgVal As String
    Dim xAddress As String
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRg = Range("A1:A3")
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
    For Each xRgEach In xRg
        xRgVal = xRgEach.Value
        If xRgVal Like "?*@?*.?*" Then
            Set xMailOut = xOutApp.CreateItem(olMailItem)
            With xMailOut
                .To = xRgVal
                .Subject = "Test"
                .Body = "Dear " _
                      & vbNewLine & vbNewLine & _
                        "This is a test email " & _
                        "sending in Excel"
                .Display
                '.Send
            End With
        End If
    Next
    Set xMailOut = Nothing
    Set xOutApp = Nothing
    Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
Hi
i need to insert a button in each row to copy the specific cell rage on the row and past it on different excel in one drive , Ex, multiple teacher working on excel and entering the student date and click the button ( post button ) once they click the date has to be actively updated in student master file in new row, (its like a dynamic consolidation of work )

If Teacher is correcting the row and clicking the post button again it needs to be verify the cell which has unique id for the student and replace the row in master file not to create duplicate row on master file on each click , i need last updated date and time on the master file in separate cell at the end of the row
This comment was minimized by the moderator on the site
Hi suriya prakash,
I am very sorry that I cannot help you with this issue yet.
This comment was minimized by the moderator on the site
In case when I am copying from one sheet to another using the below code (Using Shape - Not Button) The Value From "ToCopySHEET"!A14 is copied to J7 when the A1:A6 are Used Range but J column is empty. I want to copy it into J:J irrespective the A, B or any other column is Used but If J is vacant It must start from the first empty cell of "CopiedSHEET"!J:J.


Sub CopyToSheet()
'Updated by Extendoffice 20220729
Dim xSWName As String
Dim xSheet As Worksheet
Dim xPSheet As Worksheet
Dim xIntR As Integer
xSWName = "Copy Test Page"
On Error Resume Next
Application.ScreenUpdating = False
Set xSheet = ActiveSheet
If xSheet.Name <> "Definitions" And xSheet.Name <> "fx" And xSheet.Name <> "Needs" Then
xSheet.Range("A14").Copy
Set xPSheet = Worksheets.Item(xSWName)
xIntR = xPSheet.UsedRange.Rows.Count
xPSheet.Cells(xIntR + 1, 10).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Application.ScreenUpdating = True
End Sub
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations