Copying Sheet from one Workbook to another.

PuntingJawa

Board Regular
Joined
Feb 25, 2021
Messages
158
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I'm curious if it is possible to copy data from a worksheet to another using VBA.
Example.
I am trying to pull all data in Workbook "OP-AUX Database Test(MacroEnabled)" sheet19 to workbook "SN Log" sheet1.
With the database I have made (with massive help from this community) the macro I have auto logs particular columns on sheets2-17 to sheet19 while removing duplicates. Would there be a way to do this same task but move it to another workbook so there's less clutter and easier logging while also removing duplicates like the following VBA code? I'm currently using the following VBA to capture required information to Sheet19 on the "OP-AUX Database Test(MacroEnabled)" workbook.
VBA Code:
Private Sub Worksheet_Activate()
 Sheet2.Range("K2", Sheet2.Range("K" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("A2", Sheet19.Range("A" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("B2:B" & Sheet19.Range("A" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet2.Range("L2", Sheet2.Range("L" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("c1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("c2", Sheet19.Range("c" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("D2:D" & Sheet19.Range("C" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet3.Range("B2", Sheet3.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("e1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("e2", Sheet19.Range("e" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("F2:F" & Sheet19.Range("E" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet3.Range("C2", Sheet3.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("g1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("g2", Sheet19.Range("g" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("H2:H" & Sheet19.Range("G" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet4.Range("B2", Sheet4.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("i1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("i2", Sheet19.Range("i" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("J2:J" & Sheet19.Range("I" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet4.Range("C2", Sheet4.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("k1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("k2", Sheet19.Range("k" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("L2:L" & Sheet19.Range("K" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet5.Range("B2", Sheet5.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("m1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("m2", Sheet19.Range("m" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("N2:N" & Sheet19.Range("M" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet6.Range("B2", Sheet6.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("o1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("o2", Sheet19.Range("o" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("P2:P" & Sheet19.Range("O" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet6.Range("C2", Sheet6.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("q1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("q2", Sheet19.Range("q" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("R2:R" & Sheet19.Range("Q" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet7.Range("B2", Sheet7.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("s1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("s2", Sheet19.Range("s" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("T2:T" & Sheet19.Range("S" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet7.Range("C2", Sheet7.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("u1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("u2", Sheet19.Range("u" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("V2:V" & Sheet19.Range("U" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet8.Range("B2", Sheet8.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("w1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("w2", Sheet19.Range("w" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("X2:X" & Sheet19.Range("W" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet8.Range("C2", Sheet8.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("y1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("y2", Sheet19.Range("y" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("Z2:Z" & Sheet19.Range("Y" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet9.Range("B2", Sheet9.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("aa1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("aa2", Sheet19.Range("aa" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AB2:AB" & Sheet19.Range("AA" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet9.Range("C2", Sheet9.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ac1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ac2", Sheet19.Range("ac" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AD2:AD" & Sheet19.Range("AC" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet10.Range("B2", Sheet10.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ae1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ae2", Sheet19.Range("ae" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AF2:AF" & Sheet19.Range("AE" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet11.Range("B2", Sheet11.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ag1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ag2", Sheet19.Range("ag" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AH2:AH" & Sheet19.Range("AG" & Rows.Count).End(xlUp).Row).Value = Date


 Sheet12.Range("B2", Sheet12.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ai1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ai2", Sheet19.Range("Ai" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AJ2:AJ" & Sheet19.Range("AI" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet13.Range("B2", Sheet13.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ak1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ak2", Sheet19.Range("Ak" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AL2:AL" & Sheet19.Range("AK" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet14.Range("H2", Sheet14.Range("H" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Am1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Am2", Sheet19.Range("Am" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AN2:AN" & Sheet19.Range("AM" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet14.Range("I2", Sheet14.Range("I" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ao1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ao2", Sheet19.Range("Ao" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AP2:AP" & Sheet19.Range("AO" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet15.Range("B2", Sheet15.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Aq1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Aq2", Sheet19.Range("Aq" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AR2:AR" & Sheet19.Range("AQ" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet15.Range("C2", Sheet15.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("As1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("As2", Sheet19.Range("As" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AT2:AT" & Sheet19.Range("AS" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet16.Range("K2", Sheet16.Range("K" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Au1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Au2", Sheet19.Range("Au" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AV2:AV" & Sheet19.Range("AU" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet16.Range("L2", Sheet16.Range("L" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Aw1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Aw2", Sheet19.Range("Aw" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AX2:AX" & Sheet19.Range("AW" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet16.Range("M2", Sheet16.Range("M" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ay1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ay2", Sheet19.Range("Ay" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AZ2:AZ" & Sheet19.Range("AY" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet17.Range("B2", Sheet17.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ba1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ba2", Sheet19.Range("ba" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("BB2:BB" & Sheet19.Range("BA" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet17.Range("C2", Sheet17.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("bc1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("bc2", Sheet19.Range("bc" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("BD2:BD" & Sheet19.Range("AC" & Rows.Count).End(xlUp).Row).Value = Date
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Did you give up @PuntingJawa ?

I didn't see you post a new thread asking about your dilemma. Please let me know.

I have another code you could try, in the mean time of creating and waiting for results of that new thread, but I am unsure if you are still interested.

a few more questions, if you are still interested:

Are both of your workbooks going to be open when you run the script to copy from 1st workbook to second workbook?
Do you want to clear the contents of the destination 'LOG' prior to copying new data there? Clearing contents would remove older data/dates.
Are both the workbooks in the same folder?
How many columns/Rows are you roughly dealing with over all those worksheet to copy/paste? ie, how many columns/rows, roughly, will be in the 'LOG' sheet?
 
Upvote 0
Did you give up @PuntingJawa ?

I didn't see you post a new thread asking about your dilemma. Please let me know.

I have another code you could try, in the mean time of creating and waiting for results of that new thread, but I am unsure if you are still interested.

a few more questions, if you are still interested:

Are both of your workbooks going to be open when you run the script to copy from 1st workbook to second workbook?
Do you want to clear the contents of the destination 'LOG' prior to copying new data there? Clearing contents would remove older data/dates.
Are both the workbooks in the same folder?
How many columns/Rows are you roughly dealing with over all those worksheet to copy/paste? ie, how many columns/rows, roughly, will be in the 'LOG' sheet?
Sorry I haven't gotten around to posting my dilemma. My lead at work put in his two weeks notice so my workload has more than doubled and I haven't had time to play around with this. I'm not at my pc but I think the columns lead up to Ab. It doesn't need to clear the log in the main workbook but it would be acceptable to remove it entirely if we can log directly. If I didn't need the log workbook open that would be ideal. And yes, the log workbook would indeed be in the same folder. Again, sorry for not following up on this. I'm overloaded with my main job title and am struggling a bit to keep up.
 
Upvote 0
I finally have a moment and am caught up on my shipping duties.
Are both of your workbooks going to be open when you run the script to copy from 1st workbook to second workbook?
Preferably, no.
Do you want to clear the contents of the destination 'LOG' prior to copying new data there? Clearing contents would remove older data/dates.
If I can remove the "Log" entirely from the main workbook that would be fine. However, it isn't hurting being there and could act as a failsafe. Either way is acceptable to me.
So clearing the contents is not necessary since I can do it manually once yearly. Unfortunately, there is no yes or no answer. Yes and no are perfectly fine to this.
Are both the workbooks in the same folder?
Yes, both are in/are going to be located in the same folder. Once yearly I will simply "Save as" with the year and clear the contents of the log file we are saving to. So in that fact nothing will need to be reformatted.
How many columns/Rows are you roughly dealing with over all those worksheet to copy/paste? ie, how many columns/rows, roughly, will be in the 'LOG' sheet?
I was incorrect in my answer to this. It stops at "BD" column. So it'll be 56 columns total.
 
Upvote 0
Guess not. Anyways, if I can accomplish what I am trying to whip up for you, you will love the new code.
 
Upvote 0
Guess not. Anyways, if I can accomplish what I am trying to whip up for you, you will love the new code.
I've got an old file I can produce the same results with. It's a holiday weekend so I won't be to work until Tuesday this week. I truly look forward to it.
 
Upvote 0
@PuntingJawa Here you go, new & improved for you!

VBA Code:
'
' This section HAS to be placed at the very top of a separate module ;)
'
Public LogToSourceWorkbook              As Boolean
Public LogToDestinationWorkbook         As Boolean
'
Public LoggingDialogSheet               As DialogSheet
'
Public ColumnToCopyFrom                 As String
Public ColumnToCopyTo                   As String
Public DateColumn                       As String
'
Public DestinationWorkbookSheetToCopyTo As Worksheet
Public SourceWorkbookSheetToCopyTo      As Worksheet
Public SourceWorkbookSheetToCopyFrom    As Worksheet
'
'

Private Sub Worksheet_Activate_V3()
'
'   This script attempts to copy data from a source file and paste it into a different sheet either into the same workbook and/or a different workbook.
'       After the choice is made, it will copy data to either or both or neither.
'       Dialog sheet coding inspired by a Rick Rothstein post. Thank you Rick!
'
'   \/ \/ \/ First line of execution \/ \/ \/
    Dim DialogSheetName                 As String                           ' <-- Start code execution at the beginning of this line
    Dim DestinationWorkbookName         As String
    Dim DestinationWorkbookSheetName    As String
'
    Dim DestinationWorkbook             As Workbook
'
'
    Set SourceWorkbookSheetToCopyTo = ThisWorkbook.Worksheets("LOG")                ' <-- LOG refers to the Destination sheet in the source workbook
'
    DestinationWorkbookName = "SN Log.xlsx"                                         ' <-- Set the correct name to your Log workbook that is in the same folder
    DestinationWorkbookSheetName = "Sheet1"                                         ' <-- Set this to the SN Log sheet name
'
    LogToSourceWorkbook = False                                     ' Log To Source Workbook = False
    LogToDestinationWorkbook = False                                ' Log To Destination Workbook = False
    DialogSheetName = "CustomButtons"
'
    Application.ScreenUpdating = False                              ' Turn Screen Updating off
    Application.DisplayAlerts = False                               ' Turn Display Alerts off
'
    On Error Resume Next                                            ' Turn on error handling ... ie. Resume Next
    ActiveWorkbook.DialogSheets(DialogSheetName).Delete             ' Delete previous dialog sheet, if by chance it exists.
    Err.Clear                                                       ' Clear any triggered error code
'
    Application.DisplayAlerts = True                                ' Turn Display Alerts back on
'
    Set LoggingDialogSheet = ActiveWorkbook.DialogSheets.Add        ' Add the custom dialog sheet. Creates Dialog* worksheet
'
'
    With LoggingDialogSheet                                         ' With the created dialog sheet ...
        .BringToFront
        .Name = DialogSheetName                                     '   Rename the created dialog sheet
        .Visible = xlSheetHidden                                    '   Hide the Created/Renamed dialog sheet
'
        With .DialogFrame                                           '   With the dialog box on the created dialog sheet
            .Height = 135                                           '       Set the height of the dialog box
            .Width = 433                                            '       Set the width of the dialog box
            .Caption = "Logging options."                           '       Set the title bar caption of the dialog box to the caption
        End With
'
        .Buttons("Button 2").Visible = False                        '   Hide default 'Button 2' ie. 'OK' button
        .Buttons("Button 3").Visible = False                        '   Hide default 'Button 3' ie. 'Cancel' button
'
        .Labels.Add 230, 45, 235, 18                                '   Add a label (Interior message line) at the top of the dialog box. Distance from Left, Top, Width, Height.
        .Labels(1).Caption = "What's your logging preference?"      '   Rename the new label/message to the caption
'
        .Buttons.Add 85, 80, 220, 18                                '   Add 1st custom button Distance from Left, Top, Width, Height. Creates 'Button *'
        With .Buttons(3)                                            '   With Buttons(3) ...
            .Caption = "Log To Source Workbook Only"                '       Rename the created button to the caption
            .OnAction = "ClickedCustomButtonAction"                 '       Set the on action Sub routine to run when this button is clicked
        End With
'
        .Buttons.Add 330, 80, 150, 18                               '   Add a 2nd custom button Distance from Left, Top, Width, Height. Creates 'Button *'
        With .Buttons(4)                                            '   With Buttons(4) ...
            .Caption = "Log To Destination Workbook Only"           '       Rename the created button to the caption
            .OnAction = "ClickedCustomButtonAction"                 '       Set the on action Sub routine to run when this button is clicked
        End With
'
        .Buttons.Add 85, 115, 220, 18                                       '   Add a 3rd custom button Distance from Left, Top, Width, Height. Creates 'Button *'
        With .Buttons(5)                                                    '   With Buttons(5) ...
            .Caption = "Log to Source Workbook and Destination Workbook"    '       Rename the created button to the caption
            .OnAction = "ClickedCustomButtonAction"                         '       Set the on action Sub routine to run when this button is clicked
        End With
'
        .Buttons.Add 330, 115, 150, 18                                  '   Add a 4th custom button Distance from Left, Top, Width, Height. Creates 'Button *'
        With .Buttons(6)                                                '   With Buttons(6) ...
            .Caption = "Never Mind, Don't Log Anything"                 '       Rename the created button to the caption
            .OnAction = "ClickedCustomButtonAction"                     '       Set the on action Sub routine to run when this button is clicked
        End With
'
'       Display the dialog box to the user and await selection from the user
        Application.ScreenUpdating = True                           '   Turn Screen Updating back on, Thus displaying the completed Dialog box for the user
'
        If .Show = False Then                                       '   If the X Cancel button was clicked on the title bar then ...
            MsgBox "No problem -- nothing will be logged.", 64, "Logging cancelled."    '       64 is the icon to show, ie. the 'i' icon ;
'
            Call DeleteOurDialogSheet                                                   '       Go and Delete the dialog sheet that was created.
            Exit Sub
        End If
    End With
'
    Call DeleteOurDialogSheet                                       '   Go and Delete the dialog sheet that was created.
'
'--------------------------------------------------------------------------------------------------------------------------------------------------------
'
    Application.Calculation = xlCalculationManual                                       ' Turn Auto Calculation Mode off
    Application.ScreenUpdating = False                                                  ' Turn Screen Updating off
'
    If LogToDestinationWorkbook = True Then                                                             ' Open other workbook if we plan to log to it
        Set DestinationWorkbook = Workbooks.Open(ThisWorkbook.Path & "\" & DestinationWorkbookName)     '   Open the other workbook
        Set DestinationWorkbookSheetToCopyTo = DestinationWorkbook.Worksheets(DestinationWorkbookSheetName) '   Set the sheet name to copy to in the destination workbook
    End If
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("OP1"): ColumnToCopyFrom = "K": ColumnToCopyTo = "A": DateColumn = "B"  '-- Sheet2 to Sheet19 Pt. 1
    Call CopyPasteEtc
        ColumnToCopyFrom = "L": ColumnToCopyTo = "C": DateColumn = "D"                  '-- Sheet2 to Sheet19 Pt. 2
        Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("OP3"): ColumnToCopyFrom = "B": ColumnToCopyTo = "E": DateColumn = "F"  '-- OP3 Sheet3 to Sheet19 Pt. 1
    Call CopyPasteEtc
        ColumnToCopyFrom = "C": ColumnToCopyTo = "G": DateColumn = "H"                  '-- OP3 Sheet3 to Sheet19 Pt. 2
        Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("OP4"): ColumnToCopyFrom = "B": ColumnToCopyTo = "I": DateColumn = "J"  '-- OP4 Sheet4 to Sheet19 Pt. 1
    Call CopyPasteEtc
        ColumnToCopyFrom = "C": ColumnToCopyTo = "K": DateColumn = "L"                  '-- OP4 Sheet4 to Sheet19 Pt. 2
        Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("OP5"): ColumnToCopyFrom = "B": ColumnToCopyTo = "M": DateColumn = "N"  '-- OP5 Sheet5 to Sheet19
    Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("OP6"): ColumnToCopyFrom = "B": ColumnToCopyTo = "O": DateColumn = "P"  '-- OP6 Sheet6 to Sheet19 Pt. 1
    Call CopyPasteEtc
        ColumnToCopyFrom = "C": ColumnToCopyTo = "Q": DateColumn = "R"                  '-- OP6 Sheet6 to Sheet19 Pt. 2
        Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("OP7"): ColumnToCopyFrom = "B": ColumnToCopyTo = "S": DateColumn = "T"  '-- OP7 Sheet7 to Sheet19 Pt. 1
    Call CopyPasteEtc
        ColumnToCopyFrom = "C": ColumnToCopyTo = "U": DateColumn = "V"                  '-- OP7 Sheet7 to Sheet19 Pt. 2
        Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("OP8"): ColumnToCopyFrom = "B": ColumnToCopyTo = "W": DateColumn = "X"  '-- OP8 Sheet8 to Sheet19 Pt. 1
    Call CopyPasteEtc
        ColumnToCopyFrom = "C": ColumnToCopyTo = "Y": DateColumn = "Z"                  '-- OP8 Sheet8 to Sheet19 Pt. 2
        Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("OP9"): ColumnToCopyFrom = "B": ColumnToCopyTo = "AA": DateColumn = "AB"    '-- OP9 Sheet9 to Sheet19 Pt. 1
    Call CopyPasteEtc
        ColumnToCopyFrom = "C": ColumnToCopyTo = "AC": DateColumn = "AD"                '-- OP9 Sheet9 to Sheet19 Pt. 2
        Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("AUX CK-EXT"): ColumnToCopyFrom = "B": ColumnToCopyTo = "AE": DateColumn = "AF"   '-- AUX CK-EXT Sheet10 to Sheet19
    Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("AUX CK-INT"): ColumnToCopyFrom = "B": ColumnToCopyTo = "AG": DateColumn = "AH"   '-- AUX CK-INT Sheet11 to Sheet19
    Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("AUX EDO"): ColumnToCopyFrom = "B": ColumnToCopyTo = "AI": DateColumn = "AJ"   '-- AUX EDO Sheet12 to Sheet19
    Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("AUX GL-EXT"): ColumnToCopyFrom = "B": ColumnToCopyTo = "AK": DateColumn = "AL"   '-- AUX GL-EXT Sheet13 to Sheet19
    Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("AUX GL-INT"): ColumnToCopyFrom = "H": ColumnToCopyTo = "AM": DateColumn = "AN"   '-- AUX GL-INT Sheet14 to Sheet19 Pt. 1
    Call CopyPasteEtc
        ColumnToCopyFrom = "I": ColumnToCopyTo = "AO": DateColumn = "AP"                '-- AUX GL-INT Sheet14 to Sheet19 Pt. 2
        Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("AUX MDC+SPEC"): ColumnToCopyFrom = "B": ColumnToCopyTo = "AQ": DateColumn = "AR"   '-- AUX MDC+SPEC Sheet15 to Sheet19 Pt. 1
    Call CopyPasteEtc
        ColumnToCopyFrom = "C": ColumnToCopyTo = "AS": DateColumn = "AT"                '-- AUX MDC+SPEC Sheet15 to Sheet19 Pt. 2
        Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("AUX MLS+MKS"): ColumnToCopyFrom = "K": ColumnToCopyTo = "AU": DateColumn = "AV"   '-- AUX MLS+MKS Sheet16 to Sheet19 Pt. 1
    Call CopyPasteEtc
        ColumnToCopyFrom = "L": ColumnToCopyTo = "AW": DateColumn = "AX"                '-- AUX MLS+MKS Sheet16 to Sheet19 Pt. 2
        Call CopyPasteEtc
        ColumnToCopyFrom = "M": ColumnToCopyTo = "AY": DateColumn = "AZ"                '-- AUX MLS+MKS Sheet16 to Sheet19 Pt. 3
        Call CopyPasteEtc
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("AUX SLRU+DMCU"): ColumnToCopyFrom = "B": ColumnToCopyTo = "BA": DateColumn = "BB"   '-- AUX SLRU+DMCU Sheet17 to Sheet19 Pt. 1
    Call CopyPasteEtc
        ColumnToCopyFrom = "C": ColumnToCopyTo = "BC": DateColumn = "BD"                '-- AUX SLRU+DMCU Sheet17 to Sheet19 Pt. 2
        Call CopyPasteEtc
'
    DestinationWorkbook.Close savechanges:=True                                         ' Save/Close the 'SN Log.xlsx' workbook
'
    Application.ScreenUpdating = True                                                   ' Turn ScreenUpdating back on
    Application.Calculation = xlCalculationAutomatic                                    ' Turn Auto Calculaion back on
'
    MsgBox "Click the 'OK' button and then check the 'LOG' results."                    ' Let user know script has completed
End Sub


Sub CopyPasteEtc()
'
    If LogToSourceWorkbook = True Then
        SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & "2", SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & Rows.Count).End(xlUp)).Copy  ' Copy Column Data to Clipboard
'
        With SourceWorkbookSheetToCopyTo                                                ' Paste results to source workbook
            .Range(ColumnToCopyTo & "1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues   ' Paste Data from Source Column to End of Destination Column
            .Range(ColumnToCopyTo & "2", SourceWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp)).RemoveDuplicates 1    ' Remove Duplicates from Destination Column
            .Range(DateColumn & "2:" & DateColumn & SourceWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp).Row).Value = Date   ' Add Today's Date to next column
        End With
    End If
'
'------------------------------
'
    If LogToDestinationWorkbook = True Then
        SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & "2", SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & Rows.Count).End(xlUp)).Copy  ' Copy Column Data to Clipboard
'
        With DestinationWorkbookSheetToCopyTo                                           ' Paste results to destination workbook
            .Range(ColumnToCopyTo & "1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues   ' Paste Data from Source Column to End of Destination Column
            .Range(ColumnToCopyTo & "2", DestinationWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp)).RemoveDuplicates 1    ' Remove Duplicates from Destination Column
            .Range(DateColumn & "2:" & DateColumn & DestinationWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp).Row).Value = Date   ' Add Today's Date to next column
        End With
    End If
End Sub


Private Sub ClickedCustomButtonAction()
'
    LoggingDialogSheet.Hide                                                     ' Needed to Hide the custom dialog box later.
'
    Select Case LoggingDialogSheet.Buttons(Application.Caller).Index            ' Determine which button index # was clicked
        Case 3
            LogToSourceWorkbook = True                                          '   Log To Source Workbook
'
        Case 4
            LogToDestinationWorkbook = True                                     '   Log To Destination Workbook
'
        Case 5
            LogToSourceWorkbook = True                                          '   Log To Source Workbook
            LogToDestinationWorkbook = True                                     '   Log To Destination Workbook
'
        Case 6
            MsgBox "No problem -- nothing will be logged.", 64, "Logging cancelled."    '       64 is the icon to show, ie. the 'i' icon ;
            Call DeleteOurDialogSheet                                           '   Go and Delete the dialog sheet that was created.
            End                                                                 '   Exit program because user chose not to log anything
    End Select
End Sub                                                                         ' Delete the Dialog box and return


Private Sub DeleteOurDialogSheet()
'
    With Application                                                ' With the Application ...
        .ScreenUpdating = False                                     '   Turn Screen Updating off
        .DisplayAlerts = False                                      '   Turn Display Alerts off
'
        On Error Resume Next                                        '   Turn on error handling ... Resume Next
        DialogSheets("CustomButtons").Delete                        '   Delete 'CustomButtons' dialog sheet, if it exists
        Err.Clear                                                   '   Clear any triggered error code
'
        .DisplayAlerts = True                                       '   Turn Display Alerts back on
        .ScreenUpdating = True                                      '   Turn Screen Updating back on
    End With
End Sub

I did a search for customizing buttons and it resulted in 'Dialog sheets' to achieve the objective. Well I had never used that approach so I decided to see what it was all about. There is very little info on it because it is a very old way of performing the objective. UserForms have long replaced the objective. So I figured it might be interesting to try and use something that has been outdated for 20 years or better. As I mentioned, there is little info on it, but I think I did a fairly decent job of using it to achieve something you will like. I was unable to figure out how to put the dialog box where I wanted on the screen (centered), but other than that it seems to work very well. Perhaps another member here could assist in the positioning of the box?

Try it out and let me know what you think.
 
Upvote 0
Solution
Just checking back in @PuntingJawa. You good now?
I'm so sorry I haven't replied. I have been so busy with the workload of my shipping duties that I haven't had the chance to do anything to test this. I should have help soon but I have to train them. After which if this does work (which from looking I see no reason it shouldn't) I'll have to modify it because they have changed and added several more variations but it should be easy enough to modify. Again, I'm very sorry for not responding. I've been insanely busy.
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top