none
I TRY Again In Copy Past Function VBA Code.... RRS feed

  • Question

  • Dear Group..

    I have this code on checkbox 1 to 28 same code but differents Sheet's

    Private Sub CheckBox1_Click()
    If CheckBox1.Value = True Then
    Dim sUFile As String
    sUFile = Range("AQ3").Value
    Workbooks.Open Filename:=sUFile

       
    'Windows "Range("CE1").Activate
        Sheets("Kamp 1").Select
        Cells.Select
        Selection.Copy
        Range("C6:E6").Select
        Windows("Statistikprogram-28.xlsm").Activate
        Sheets("Kamp 1").Select
        Cells.Select
        ActiveSheet.Paste
        Range("C6:E6").Select
       
        'MsgBox "Success"
        End If
    End Sub

    ----

    Private Sub CheckBox2_Click()
    If CheckBox2.Value = True Then
    Dim sUFile As String
    sUFile = Range("AQ3").Value
    Workbooks.Open Filename:=sUFile
       ' Windows("Statistikprogram-28-2014-2015-3-DS").Activate
        Sheets("Kamp 2").Select
        Cells.Select
        Selection.Copy
        Range("C6:E6").Select
        Windows("Statistikprogram-28.xlsm").Activate
        Sheets("Kamp 2").Select
        Cells.Select
        Sheets("Kamp 2").Select
        ActiveSheet.Paste
        Range("C6:E6").Select

        'MsgBox "Success"
        End If
    End Sub

    WHEN i try to make Checkbox Running it say's ERROR in this line

    I have Try the function But need To Get File From folder For each Time to copy ....From Userform

    Workbooks.Open Filename:=sUFile

    I Understand That :That the file is OPEN how can i get this to Work

    Both file are Here from dropbox

    Main File

    https://www.dropbox.com/s/o2cmtyc21ujr8ix/Statistikprogram-28.xlsm?dl=0

    To start Userform press [CTRL+SHIFT+Y]

    File Copy from

    https://www.dropbox.com/s/s195tkkyfaygdea/Statistikprogram-28-2014-2015-3-DS.xlsm?dl=0

    THE MAIN CODE for Both Project is "Dart" Big "D"

    Henrik-1

    Monday, March 9, 2015 7:21 AM

Answers

  • I am not certain that I properly understand what you want to do. (I have not downloaded your workbook examples.) Here is how I interpret your question.

    You want to open the workbook with the name in cell AQ3.

    If the workbook is already open then simply reference the workbook without opening again.

    Copy all the cells in worksheet Kamp 1 of the opened workbook and paste them into a worksheet by the same name in the workbook containing the code.

    If the above is correct then the code below.

    I do not know what worksheet contains the cell AQ3 so see my comment about editing to the correct the sheet name.

    Ensure that you back up your workbooks before running the code in case it does not do what you expect.

    Private Sub CheckBox1_Click()
        If CheckBox1.Value = True Then
            Dim wbThis As Workbook
            Dim wbToCopy As Workbook
            Dim sUFile As String
           
            'I am assuming that "Statistikprogram-28.xlsm" _
             is the workbook containing the code
            Set wbThis = ThisWorkbook
           
            'Next line edit "Sheet1" to the worksheet where Range("AQ3") is located
            sUFile = wbThis.Sheets("Sheet1").Range("AQ3").Value
           
            On Error Resume Next
            'Attempt to assign the workbook to copy from to a variable _
             It will error if the workbook is not already open _
             and hense the On Error Resume Next
            Set wbToCopy = Workbooks(sUFile)
            On Error GoTo 0
           
            If wbToCopy Is Nothing Then     'If nothing then workbook not already open
                'Therefore open the workbook and assign to the workbook variable
                Set wbToCopy = Workbooks.Open(Filename:=sUFile)
            End If
           
            'Following line copies and pastes in one line of code (Note space between Copy and Destination.)
            wbToCopy.Sheets("Kamp 1").Cells.Copy  Destination:=wbThis.Sheets("Kamp 1").Range("A1")

            'Next line ensures ThisWorkbook (with the code) is the active workbook.
            wbThis.Activate
            Sheets("Kamp 1").Select
            Range("C6:E6").Select
           
        End If
    End Sub


    Regards, OssieMac

    • Marked as answer by Henrik-1 Tuesday, March 10, 2015 11:13 AM
    Monday, March 9, 2015 11:49 AM
  • The copy should Only copy Area start from (C6 to AD46)

    Hello Henrik,

    This is the first time you have mentioned the above in the entire thread. In you initial code you were copying the entire worksheet and then selecting C6:E6. However, try the following and see if that is what you want. It copies C6:AD46 and pastes that range. Note that the full range is referenced to Copy but only the first cell needs to be referenced for the paste.

    I have assumed that the workbook name in AQ3 is on worksheet Kamp 1. If not then edit that line in the code.

    Private Sub CheckBox1_Click()
         If CheckBox1.Value = True Then
             Dim wbThis As Workbook
             Dim wbToCopy As Workbook
             Dim sUFile As String
            
             'I am assuming that "Statistikprogram-28.xlsm" _
              is the workbook containing the code
             Set wbThis = ThisWorkbook
            
             'I have assumed that Range("AQ3") is located on worksheet Kamp 1. If not then edit sheet name.
             sUFile = wbThis.Sheets("Kamp 1").Range("AQ3").Value
            
             On Error Resume Next
             'Attempt to assign the workbook to copy from to a variable _
              It will error if the workbook is not already open _
              and hense the On Error Resume Next
             Set wbToCopy = Workbooks(sUFile)
             On Error GoTo 0
            
             If wbToCopy Is Nothing Then     'If nothing then workbook not already open
                 'Therefore open the workbook and assign to the workbook variable
                 Set wbToCopy = Workbooks.Open(Filename:=sUFile)
             End If
            
             'Following line copies and pastes in one line of code (Note space between Copy and Destination.)
             wbToCopy.Sheets("Kamp 1").Range("C6:AD46").Copy Destination:=wbThis.Sheets("Kamp 1").Range("C6")

            'Next line ensures ThisWorkbook (with the code) is the active workbook.
            wbThis.Activate
            Sheets("Kamp 1").Select
            ActiveSheet.Range("C6:E6").Select
            
         End If
     End Sub


    Regards, OssieMac

    • Marked as answer by Henrik-1 Wednesday, March 11, 2015 10:09 PM
    Wednesday, March 11, 2015 8:36 PM
  • a Little Question about this code Is it Possibel To make it to Be Hide when its open
      Set wbToCopy = Workbooks.Open(Filename:=sUFile)

    Henrick,

    Yes! It is possible to hide it. However, you cannot close it until it is unhidden again or you close Excel.

    If you close Excel before unhiding the workbook then it will still be hidden again when it is opened. However, you can unhide it as follows.

    To unhide a workbook manually

    1. Select View ribbon
    2. Select Unhide (Near centre of ribbon)
    3. In the popup dialog select the workbook name and then OK.

    I suggest that you simply disable screen updating so you do not see the flashing screen like the example code below. I have included a line that I have commented out to hide the workbook if you really want to. Simply remove the comment marker (single quote) from the beginning of the line.

    Private Sub CheckBox1_Click()
         If CheckBox1.Value = True Then
             Dim wbThis As Workbook
             Dim wbToCopy As Workbook
             Dim sUFile As String
            
             Application.ScreenUpdating = False
             'I am assuming that "Statistikprogram-28.xlsm" _
              is the workbook containing the code
             Set wbThis = ThisWorkbook
            
             'I have assumed that Range("AQ3") is located on worksheet Kamp 1
             sUFile = wbThis.Sheets("Kamp 1").Range("AQ3").Value
            
             On Error Resume Next
             'Attempt to assign the workbook to copy from to a variable _
              It will error if the workbook is not already open _
              and hense the On Error Resume Next
             Set wbToCopy = Workbooks(sUFile)
             On Error GoTo 0
            
             If wbToCopy Is Nothing Then     'If nothing then workbook not already open
                 'Therefore open the workbook and assign to the workbook variable
                 Set wbToCopy = Workbooks.Open(Filename:=sUFile)
                 'ActiveWindow.Visible = False      'Uncomment to hide the workbook when opened
             End If
            
             'Following line copies and pastes in one line of code (Note space between Copy and Destination.)
             wbToCopy.Sheets("Kamp 1").Range("C6:AD46").Copy Destination:=wbThis.Sheets("Kamp 1").Range("C6")

            'Next line ensures ThisWorkbook (with the code) is the active workbook.
            wbThis.Activate
            Sheets("Kamp 1").Select
            ActiveSheet.Range("C6:E6").Select
            Application.ScreenUpdating = True
            
         End If
     End Sub


    Regards, OssieMac

    • Marked as answer by Henrik-1 Thursday, March 12, 2015 4:49 AM
    Wednesday, March 11, 2015 11:41 PM

All replies

  • I am not certain that I properly understand what you want to do. (I have not downloaded your workbook examples.) Here is how I interpret your question.

    You want to open the workbook with the name in cell AQ3.

    If the workbook is already open then simply reference the workbook without opening again.

    Copy all the cells in worksheet Kamp 1 of the opened workbook and paste them into a worksheet by the same name in the workbook containing the code.

    If the above is correct then the code below.

    I do not know what worksheet contains the cell AQ3 so see my comment about editing to the correct the sheet name.

    Ensure that you back up your workbooks before running the code in case it does not do what you expect.

    Private Sub CheckBox1_Click()
        If CheckBox1.Value = True Then
            Dim wbThis As Workbook
            Dim wbToCopy As Workbook
            Dim sUFile As String
           
            'I am assuming that "Statistikprogram-28.xlsm" _
             is the workbook containing the code
            Set wbThis = ThisWorkbook
           
            'Next line edit "Sheet1" to the worksheet where Range("AQ3") is located
            sUFile = wbThis.Sheets("Sheet1").Range("AQ3").Value
           
            On Error Resume Next
            'Attempt to assign the workbook to copy from to a variable _
             It will error if the workbook is not already open _
             and hense the On Error Resume Next
            Set wbToCopy = Workbooks(sUFile)
            On Error GoTo 0
           
            If wbToCopy Is Nothing Then     'If nothing then workbook not already open
                'Therefore open the workbook and assign to the workbook variable
                Set wbToCopy = Workbooks.Open(Filename:=sUFile)
            End If
           
            'Following line copies and pastes in one line of code (Note space between Copy and Destination.)
            wbToCopy.Sheets("Kamp 1").Cells.Copy  Destination:=wbThis.Sheets("Kamp 1").Range("A1")

            'Next line ensures ThisWorkbook (with the code) is the active workbook.
            wbThis.Activate
            Sheets("Kamp 1").Select
            Range("C6:E6").Select
           
        End If
    End Sub


    Regards, OssieMac

    • Marked as answer by Henrik-1 Tuesday, March 10, 2015 11:13 AM
    Monday, March 9, 2015 11:49 AM
  • I got Error in this Line

     Set wbToCopy = Workbooks.Open(Filename:=sUFile)

    When i try to copy sheet 2

    sheet 1 Works ok

    Youre Regards from Henrik-1

    Monday, March 9, 2015 12:41 PM
  • If you want to open a file that might be open already then you need a function to check whether it is open e.g.

    Public Function GetWorkbook(ByVal sFullName As String) As Workbook
    Dim sFile As String
    Dim wbReturn As Workbook
        sFile = Dir(sFullName)
        On Error Resume Next
        Set wbReturn = Workbooks(sFile)
        If wbReturn Is Nothing Then
            Set wbReturn = Workbooks.Open(sFullName)
        End If
        On Error GoTo lbl_Exit
        Set GetWorkbook = wbReturn
    lbl_Exit:
        Exit Function
    End Function
    You can then call that function from your code in place of
    Set wbToCopy = Workbooks.Open(Filename:=sUFile)
    i.e.
    Set wbToCopy = GetWorkbook(sUFile)


    Graham Mayor - Word MVP
    www.gmayor.com


    Monday, March 9, 2015 1:01 PM
  • Where to put first part of the code ??

    Henrik-1

    Monday, March 9, 2015 5:59 PM
  • I got Error in this Line

     Set wbToCopy = Workbooks.Open(Filename:=sUFile)

    When i try to copy sheet 2

    sheet 1 Works ok

    Youre Regards from Henrik-1

    When you say that sheet 1 works ok do you mean using the code I provided that it works ok or on your original code that it works ok. Did you use my code for both checkbox events? If not, then you should.

    Did you edit the sheet name for the cell AQ3? Because I am not sure what you are trying to do I don't know if you need to edit this in each Checkbox event.


    Regards, OssieMac

    Tuesday, March 10, 2015 12:32 AM
  • Where to put first part of the code ??

    Henrik-1

    Did you mean

    Public Function GetWorkbook(ByVal sFullName As String) As Workbook

    Put the code in the same module as the original code.

    Graham Mayor - Word MVP
    www.gmayor.com

    Tuesday, March 10, 2015 8:14 AM
  • OssieMac..

    Yes i have used the same code and change em for Each Sheet for the Function AQ3

    AND it was your Code i Used.

    But i think there is a Little Nasty Trick with it Because in then main AQ3 function is ok

    but when i want to copy Sheet1 from a Older version of this File the AQ3 function is not there

    and then AQ3 is empty in  Original file "the file i am trying to get this copy / Paste function to Work"

    ANd that's Meen THER is No Copy / Paste Function in OLD files only the new And Forward.

    Your regards From Henrik-1
    ps Sorry i didn tell you that in the first Message

    Tuesday, March 10, 2015 10:37 AM
  • Sorry Graham But i use they other code i got in here ANd it Works fine after a Little mistake in sheet.

    Your Regards From Henrik-1

    Tuesday, March 10, 2015 11:38 AM
  • HM HM I have now test the Function and got a Minor problem with another Function i have on EVERY sheet.
    1 to 28

    I have a Macro there are Cleaning Each Sheet when sheet are Active and Button are press and Password are written.

    But when i press that Button It's Open The File wich have being Copy-from

    Henrik-1

    Tuesday, March 10, 2015 11:59 AM
  • If I am understanding correctly, when you copy a formula from one workbook to another then the formulas remain linked back to the original source (which is the original workbook). Check your formulas and see if the original workbook name is now included in the formula.


    Regards, OssieMac

    Tuesday, March 10, 2015 11:51 PM
  • I think ill Find the error....

    The VBA code you perfectly have made Works Ok to COPY / PASTE.

    But the problem is It take's Whole Sheet's

    and on those sheets there are 4 Picture wich is Button for 4 extra Function

    and it's them there Now is giving Trouble because the Link isen't there after Copy/past.

    The copy should Only copy Area start from (C6 to AD46)

    Hope that will Help you

    Henrik-1

    Denmark

    Wednesday, March 11, 2015 12:09 PM
  • The copy should Only copy Area start from (C6 to AD46)

    Hello Henrik,

    This is the first time you have mentioned the above in the entire thread. In you initial code you were copying the entire worksheet and then selecting C6:E6. However, try the following and see if that is what you want. It copies C6:AD46 and pastes that range. Note that the full range is referenced to Copy but only the first cell needs to be referenced for the paste.

    I have assumed that the workbook name in AQ3 is on worksheet Kamp 1. If not then edit that line in the code.

    Private Sub CheckBox1_Click()
         If CheckBox1.Value = True Then
             Dim wbThis As Workbook
             Dim wbToCopy As Workbook
             Dim sUFile As String
            
             'I am assuming that "Statistikprogram-28.xlsm" _
              is the workbook containing the code
             Set wbThis = ThisWorkbook
            
             'I have assumed that Range("AQ3") is located on worksheet Kamp 1. If not then edit sheet name.
             sUFile = wbThis.Sheets("Kamp 1").Range("AQ3").Value
            
             On Error Resume Next
             'Attempt to assign the workbook to copy from to a variable _
              It will error if the workbook is not already open _
              and hense the On Error Resume Next
             Set wbToCopy = Workbooks(sUFile)
             On Error GoTo 0
            
             If wbToCopy Is Nothing Then     'If nothing then workbook not already open
                 'Therefore open the workbook and assign to the workbook variable
                 Set wbToCopy = Workbooks.Open(Filename:=sUFile)
             End If
            
             'Following line copies and pastes in one line of code (Note space between Copy and Destination.)
             wbToCopy.Sheets("Kamp 1").Range("C6:AD46").Copy Destination:=wbThis.Sheets("Kamp 1").Range("C6")

            'Next line ensures ThisWorkbook (with the code) is the active workbook.
            wbThis.Activate
            Sheets("Kamp 1").Select
            ActiveSheet.Range("C6:E6").Select
            
         End If
     End Sub


    Regards, OssieMac

    • Marked as answer by Henrik-1 Wednesday, March 11, 2015 10:09 PM
    Wednesday, March 11, 2015 8:36 PM
  • Yes i Know AND i am Terribel Sorry for not giving the info in the first time....

    IT Works now .

    a Little Question about this code Is it Possibel To make it to Be Hide when its open
      Set wbToCopy = Workbooks.Open(Filename:=sUFile)

    just a Option

    Your Regards From Henrik-1

    • Edited by Henrik-1 Wednesday, March 11, 2015 10:31 PM
    Wednesday, March 11, 2015 9:11 PM
  • a Little Question about this code Is it Possibel To make it to Be Hide when its open
      Set wbToCopy = Workbooks.Open(Filename:=sUFile)

    Henrick,

    Yes! It is possible to hide it. However, you cannot close it until it is unhidden again or you close Excel.

    If you close Excel before unhiding the workbook then it will still be hidden again when it is opened. However, you can unhide it as follows.

    To unhide a workbook manually

    1. Select View ribbon
    2. Select Unhide (Near centre of ribbon)
    3. In the popup dialog select the workbook name and then OK.

    I suggest that you simply disable screen updating so you do not see the flashing screen like the example code below. I have included a line that I have commented out to hide the workbook if you really want to. Simply remove the comment marker (single quote) from the beginning of the line.

    Private Sub CheckBox1_Click()
         If CheckBox1.Value = True Then
             Dim wbThis As Workbook
             Dim wbToCopy As Workbook
             Dim sUFile As String
            
             Application.ScreenUpdating = False
             'I am assuming that "Statistikprogram-28.xlsm" _
              is the workbook containing the code
             Set wbThis = ThisWorkbook
            
             'I have assumed that Range("AQ3") is located on worksheet Kamp 1
             sUFile = wbThis.Sheets("Kamp 1").Range("AQ3").Value
            
             On Error Resume Next
             'Attempt to assign the workbook to copy from to a variable _
              It will error if the workbook is not already open _
              and hense the On Error Resume Next
             Set wbToCopy = Workbooks(sUFile)
             On Error GoTo 0
            
             If wbToCopy Is Nothing Then     'If nothing then workbook not already open
                 'Therefore open the workbook and assign to the workbook variable
                 Set wbToCopy = Workbooks.Open(Filename:=sUFile)
                 'ActiveWindow.Visible = False      'Uncomment to hide the workbook when opened
             End If
            
             'Following line copies and pastes in one line of code (Note space between Copy and Destination.)
             wbToCopy.Sheets("Kamp 1").Range("C6:AD46").Copy Destination:=wbThis.Sheets("Kamp 1").Range("C6")

            'Next line ensures ThisWorkbook (with the code) is the active workbook.
            wbThis.Activate
            Sheets("Kamp 1").Select
            ActiveSheet.Range("C6:E6").Select
            Application.ScreenUpdating = True
            
         End If
     End Sub


    Regards, OssieMac

    • Marked as answer by Henrik-1 Thursday, March 12, 2015 4:49 AM
    Wednesday, March 11, 2015 11:41 PM
  • Thanks It Works's Better now

    Your Regards From Henrik-1

    Denmark

    Thursday, March 12, 2015 4:50 AM