Ugrás a tartalomra

Hogyan hozzunk létre egy Parancs gombot az adatok Excelbe másolásához és beillesztéséhez?

Ha feltételezzük, hogy az adatok megváltoztatása után gyakran kell másolnia egy cellatartományt más helyre, a manuális másolás és beillesztés módszer nehézkes és időigényes lesz. Hogyan lehet ezt a másolási és beillesztési ügyet automatikusan futtatni? Ez a cikk bemutatja, hogyan használhatja a parancsgombot az adatok egyetlen kattintással történő másolásához és beillesztéséhez.

Hozzon létre egy Parancs gombot az adatok VBA kóddal történő másolásához és beillesztéséhez

Hozzon létre egy Parancs gombot az adatok VBA kóddal történő másolásához és beillesztéséhez

Kérjük, tegye a következőket az adatok automatikus másolásához és beillesztéséhez, amikor a Parancs gombra kattint.

1. Kattintson a gombra a Parancs gombra kattintással Fejlesztő > betétlap > Parancs gomb (ActiveX vezérlő). Lásd a képernyőképet:

2. Rajzoljon egy parancsgombot a munkalapjára, és kattintson rá a jobb gombbal. Válassza a lehetőséget Kód megtekintése a helyi menüből.

3. A felbukkanóban Microsoft Visual Basic for Applications ablakban, kérjük, cserélje ki az eredeti kódot a Kód ablakban az alábbi VBA kódra.

VBA-kód: Használja a Parancs gombot az adatok másolásához és beillesztéséhez az Excel-be

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

Megjegyzések: A kódban a CommandButton1 a beillesztett Parancsgomb neve. A1: C17 a másolandó tartomány, a J1: L17 pedig az adatok beillesztésének céltartománya. Kérjük, változtassa meg őket szükség szerint.

4. nyomja meg más + Q gombok a Microsoft Visual Basic for Applications ablak. És kapcsolja ki a Tervezési módot a Fejlesztő fül alatt.

5. Most kattintson a Parancs gombra, az A1: C17 tartomány összes adata a cella formázása nélkül átmásolásra és beillesztésre kerül a J1: L17 tartományba.

Kapcsolódó cikkek:

A legjobb irodai hatékonyságnövelő eszközök

🤖 Kutools AI Aide: Forradalmasítsa az adatelemzést a következők alapján: Intelligens végrehajtás   |  Kód létrehozása  |  Hozzon létre egyéni képleteket  |  Adatok elemzése és diagramok létrehozása  |  A Kutools funkciók meghívása...
Népszerű szolgáltatások: Ismétlődések keresése, kiemelése vagy azonosítása   |  Üres sorok törlése   |  Oszlopok vagy cellák kombinálása adatvesztés nélkül   |   Kerek Formula nélkül ...
Szuper keresés: Több kritérium VLookup  |   Többértékű VLookup  |   VLookup több munkalapon   |   Fuzzy Lookup ....
Speciális legördülő lista: Gyors legördülő lista létrehozása   |  Függő legördülő lista   |  Többszörösen válassza ki a legördülő listát ....
Oszlopkezelő: Adjon meg egy adott számú oszlopot  |  Oszlopok mozgatása  |  Kapcsolja be a Rejtett oszlopok láthatósági állapotát  |  Tartományok és oszlopok összehasonlítása ...
Kiemelt funkciók: Rács fókusz   |  Design nézet   |   Nagy Formula bár   |  Munkafüzet és lapkezelő   |  Erőforrás-könyvtár (Auto szöveg)   |  Dátumválasztó   |  Kombinálja a munkalapokat   |  Cellák titkosítása/dekódolása   |  E-mailek küldése listánként   |  Szuper szűrő   |   Speciális szűrő (félkövér/dőlt/áthúzott szűrés...) ...
A 15 legjobb eszközkészlet:  12 szöveg Eszközök (Szöveg hozzáadása, Karakterek eltávolítása,...)   |   50 + Táblázatos Típusai (Gantt-diagram,...)   |   40+ Praktikus képletek (Számolja ki az életkort a születésnap alapján,...)   |   19 beszúrás Eszközök (Helyezze be a QR-kódot, Kép beszúrása az útvonalból,...)   |   12 Átalakítás Eszközök (Számok szavakig, Valuta átváltás,...)   |   7 Egyesítés és felosztás Eszközök (Haladó kombinált sorok, Hasított sejtek,...)   |   ... és több

Töltsd fel Excel-készségeidet a Kutools for Excel segítségével, és tapasztald meg a még soha nem látott hatékonyságot. A Kutools for Excel több mint 300 speciális funkciót kínál a termelékenység fokozásához és az időmegtakarításhoz.  Kattintson ide, hogy megszerezze a leginkább szükséges funkciót...

Leírás

Az Office lap füles felületet hoz az Office-ba, és sokkal könnyebbé teszi a munkáját

  • Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
  • Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
  • 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
Comments (61)
Rated 4.5 out of 5 · 2 ratings
Muhammad Mubasher Liaqat Abbasi
Muhammad Mubasher Liaqat Abbasi
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.
Reply
0
0
Rated 4.5 out of 5
Ivan
Ivan
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.
Reply
0
0
crystal
crystal     Ivan
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.
Reply
Report
0
0
NGUYEN MANH HUNG
NGUYEN MANH HUNG
This comment was minimized by the moderator on the site
Cảm ơn bạn
Reply
0
0
Rated 4.5 out of 5
Gabriel
Gabriel
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
Reply
0
0
crystal
crystal     Gabriel
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
Reply
Report
0
0
Calle
Calle
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
Reply
0
0
crystal
crystal     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.
Reply
Report
0
0
Clément
Clément
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.
Reply
0
0
crystal
crystal     Clément
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
Reply
Report
0
0
Clément
Clément
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 !
Reply
0
0
Clement
Clement
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 ?
Reply
0
0
crystal
crystal     Clement
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
Reply
Report
0
0
suriya prakash
suriya prakash
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
Reply
0
0
crystal
crystal     suriya prakash
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.
Reply
Report
0
0
Ankur Batabyal
Ankur Batabyal
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
Reply
0
0
There are no comments posted here yet
Load More
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations