Skip i'r prif gynnwys

Sut i greu Botwm Gorchymyn i gopïo a gludo data yn Excel?

Gan dybio bod angen i chi gopïo ystod o gelloedd i le arall yn aml ar ôl newid y data, bydd y dull copïo a gludo â llaw yn ffyslyd ac yn cymryd amser. Sut i wneud i'r berthynas gopïo a gludo hon redeg yn awtomatig? Bydd yr erthygl hon yn dangos i chi sut i ddefnyddio botwm gorchymyn i gopïo a gludo data gyda dim ond un clic.

Creu Botwm Gorchymyn i gopïo a gludo data gyda chod VBA

Creu Botwm Gorchymyn i gopïo a gludo data gyda chod VBA

Gwnewch fel a ganlyn i gopïo a gludo data yn awtomatig wrth glicio Botwm Gorchymyn.

1. Mewnosodwch Botwm Gorchymyn trwy glicio Datblygwr > Mewnosod > Botwm Gorchymyn (Rheoli ActiveX). Gweler y screenshot:

2. Tynnwch Botwm Gorchymyn yn eich taflen waith a chliciwch arno ar y dde. Dewiswch Gweld y Cod o'r ddewislen cyd-destun.

3. Yn y popping up Microsoft Visual Basic ar gyfer Ceisiadau ffenestr, disodli'r cod gwreiddiol yn ffenestr y Cod gyda chod VBA islaw.

Cod VBA: Defnyddiwch Botwm Gorchymyn i gopïo a gludo data yn 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

Nodyn: Yn y cod, CommandButton1 yw enw'ch Botwm Gorchymyn a fewnosodwyd. A1: C17 yw'r ystod y mae angen i chi ei chopïo, a J1: L17 yw'r amrediad cyrchfan i gludo data. Newidiwch nhw yn ôl yr angen.

4. Gwasgwch Alt + Q allweddi i gau'r Microsoft Visual Basic ar gyfer Ceisiadau ffenestr. A diffoddwch y Modd Dylunio o dan y tab Datblygwr.

5. Nawr cliciwch y Botwm Gorchymyn, bydd yr holl ddata yn ystod A1: C17 yn cael ei gopïo a'i gludo i ystod J1: L17 heb fformatio'r gell.

Erthyglau perthnasol:

Offer Cynhyrchiant Swyddfa Gorau

Nodweddion Poblogaidd: Darganfod, Amlygu neu Adnabod Dyblygiadau   |  Dileu Rhesi Gwag   |  Cyfuno Colofnau neu Gelloedd heb Colli Data   |   Rownd heb Fformiwla ...
Super-edrych: VLookup Meini Prawf Lluosog  |   VLookup Gwerth Lluosog  |   VLookup Ar Draws Taflenni Lluosog   |   Edrych Niwlog ....
Rhestr gwympo Uwch: Creu Rhestr Gollwng yn Gyflym   |  Rhestr Gollwng Dibynnol   |  Rhestr Gollwng Aml-ddewis ....
Rheolwr Colofn: Ychwanegu Nifer Penodol o Golofnau  |  Symud Colofnau  |  Toglo Statws Gwelededd Colofnau Cudd  |  Cymharwch Ystodau a Cholofnau ...
Nodweddion dan Sylw: Ffocws ar y Grid   |  Golwg Dylunio   |   Bar Fformiwla Mawr   |  Rheolwr Llyfr Gwaith a Thaflen   |  Llyfrgell Adnoddau (Testun Auto)   |  Dewiswr Dyddiad   |  Cyfuno Taflenni Gwaith   |  Amgryptio/Dadgryptio Celloedd   |  Anfon E-byst trwy Restr   |  Hidlo Super   |   Hidlo Arbennig (hidlo mewn print trwm/italig/strikethrough...) ...
15 Set Offer Gorau:  12 Testun offer (Ychwanegu Testun, Dileu Cymeriadau,...)   |   50 + Siart Mathau (Siart Gantt,...)   |   40+ Ymarferol Fformiwlâu (Cyfrifwch oedran yn seiliedig ar ben-blwydd,...)   |   19 mewnosod offer (Mewnosod Cod QR, Mewnosod Llun o'r Llwybr,...)   |   12 Trosi offer (Rhifau i Eiriau, Trosi arian cyfred,...)   |   7 Uno a Hollti offer (Rhesi Cyfuno Uwch, Celloedd Hollt,...)   |   ... a mwy

Supercharge Eich Sgiliau Excel gyda Kutools for Excel, a Phrofiad Effeithlonrwydd Fel Erioed Erioed o'r blaen. Kutools for Excel Yn cynnig dros 300 o nodweddion uwch i hybu cynhyrchiant ac arbed amser.  Cliciwch Yma i Gael Y Nodwedd Sydd Ei Angen Y Mwyaf...

tab kte 201905

Office Tab Yn dod â rhyngwyneb Tabbed i Office, ac yn Gwneud Eich Gwaith yn Haws o lawer

  • Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
  • Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
  • Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!
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