• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copying particular cells from one workbook to another based on the text in another cell.

Brooksy1

New Member
Hello all,

My first post on here so please let me know if i need to do anything more in this post.

I have a workbook that holds some data and a dropdown box. What i would like to do is get some VBA code that would copy and past particular active cells to another workbook on a shared drive. However i would like to alter which workbook it copies the cells to depending on which text is selected in the drop down box. I have attached an example of the workbook to help.

The cells i would want to copy are A7:A27, C7:C27 but only if they have text in them.

The drop down box is in cell B2 on the attached example and the two options are "Book 1" or "Book 2"

I would also be running this VBA multiple times a day for different data (as the sending book is a template that will be clean of data each time it is opened) so would need the code to paste below any rows that are already in use on the book where the data will be posted.

I hope this makes sense.

I have searched this forum and others and although there is a lot of posts about this subject across the net they do not refer to one cell with multiple options and tend to copy entire rows which is not what i would like to happen if possible.

Many thanks for any help in advance.
 

Attachments

  • Example.xlsx
    9.2 KB · Views: 5
Hello all,

My first post on here so please let me know if i need to do anything more in this post.

I have a workbook that holds some data and a dropdown box. What i would like to do is get some VBA code that would copy and past particular active cells to another workbook on a shared drive. However i would like to alter which workbook it copies the cells to depending on which text is selected in the drop down box. I have attached an example of the workbook to help.

The cells i would want to copy are A7:A27, C7:C27 but only if they have text in them.

The drop down box is in cell B2 on the attached example and the two options are "Book 1" or "Book 2"

I would also be running this VBA multiple times a day for different data (as the sending book is a template that will be clean of data each time it is opened) so would need the code to paste below any rows that are already in use on the book where the data will be posted.

I hope this makes sense.

I have searched this forum and others and although there is a lot of posts about this subject across the net they do not refer to one cell with multiple options and tend to copy entire rows which is not what i would like to happen if possible.

Many thanks for any help in advance.
Hi and welcome to the forum :)

Please try the following (you must have all 3 workbooks open before running the code and the other 2 files must be named exactly as in cell "B2"):
Code:
Sub CopyPaste()

    Dim lrow, lrow1 As Integer
 
    lrow = Sheets("Calculations").Columns("A").Cells(Rows.Count).End(xlUp).Row
    lrow1 = Workbooks(Range("B2").Value).Sheets(1).Columns("A").Cells(Rows.Count).End(xlUp).Row + 1

    Sheets("Calculations").Range("A7:A" & lrow & "," & "C7:C" & lrow).Copy Workbooks(Range("B2").Value).Sheets(1).Range("A" & lrow1)

End Sub

Code should be placed in the sending/source workbook... Please refer to the attached files

Hope this helps
 

Attachments

  • Example.xlsm
    19 KB · Views: 5
  • Book 1.xlsx
    8.1 KB · Views: 4
  • Book 2.xlsx
    8.1 KB · Views: 4
Hi and welcome to the forum :)

Please try the following (you must have all 3 workbooks open before running the code and the other 2 files must be named exactly as in cell "B2"):
Code:
Sub CopyPaste()

    Dim lrow, lrow1 As Integer

    lrow = Sheets("Calculations").Columns("A").Cells(Rows.Count).End(xlUp).Row
    lrow1 = Workbooks(Range("B2").Value).Sheets(1).Columns("A").Cells(Rows.Count).End(xlUp).Row + 1

    Sheets("Calculations").Range("A7:A" & lrow & "," & "C7:C" & lrow).Copy Workbooks(Range("B2").Value).Sheets(1).Range("A" & lrow1)

End Sub

Code should be placed in the sending/source workbook... Please refer to the attached files

Hope this helps
PCosta87

Thank you that works beautifully!

The only one thing i would like is for it to work without the book open as in the macro will open the correct book paste the appropriate data and close the receiving book again. Is this something that is possible?

Apologies i should have probably said this in the original post.
 
PCosta87

Thank you that works beautifully!

The only one thing i would like is for it to work without the book open as in the macro will open the correct book paste the appropriate data and close the receiving book again. Is this something that is possible?

Apologies i should have probably said this in the original post.
No problem :)

Replace with
Code:
Sub CopyPaste()

    Dim lrow, lrow1 As Integer
    Dim Path, Dest, Source As String
   
    Source = ActiveWorkbook.Name
    lrow = Workbooks(Source).Sheets("Calculations").Columns("A").Cells(Rows.Count).End(xlUp).Row
    Dest = Workbooks(Source).Sheets("Calculations").Range("B2").Value
    Path = "D:\" & Dest & ".xlsx"
   
    Workbooks.Open Path
        lrow1 = Workbooks(Dest).Sheets(1).Columns("A").Cells(Rows.Count).End(xlUp).Row + 1
        Workbooks(Source).Sheets("Calculations").Range("A7:A" & lrow & "," & "C7:C" & lrow).Copy Workbooks(Dest).Sheets(1).Range("A" & lrow1)
    Workbooks(Dest).Close savechanges:=True

End Sub

Note that I used "D:\..." you need to replace this path with the one where you have your 2 files. Also, change the ".xlsx" if your files have a different extension.

Hope this helps
 
No problem :)

Replace with
Code:
Sub CopyPaste()

    Dim lrow, lrow1 As Integer
    Dim Path, Dest, Source As String
  
    Source = ActiveWorkbook.Name
    lrow = Workbooks(Source).Sheets("Calculations").Columns("A").Cells(Rows.Count).End(xlUp).Row
    Dest = Workbooks(Source).Sheets("Calculations").Range("B2").Value
    Path = "D:\" & Dest & ".xlsx"
  
    Workbooks.Open Path
        lrow1 = Workbooks(Dest).Sheets(1).Columns("A").Cells(Rows.Count).End(xlUp).Row + 1
        Workbooks(Source).Sheets("Calculations").Range("A7:A" & lrow & "," & "C7:C" & lrow).Copy Workbooks(Dest).Sheets(1).Range("A" & lrow1)
    Workbooks(Dest).Close savechanges:=True

End Sub

Note that I used "D:\..." you need to replace this path with the one where you have your 2 files. Also, change the ".xlsx" if your files have a different extension.

Hope this helps
Thanks again PCosta87

I have tried to make it work but i keep getting a 'subscript out of range' error. The following line is highlighted in the debugger.

lrow1 = Workbooks(Dest).Sheets(1).Columns("A").Cells(Rows.Count).End(xlUp).Row + 1

This happens regardless of which sheet i select in the drop down. The appropriate workbook opens but nothing is copied before this error is shown. So close!
 
Thanks again PCosta87

I have tried to make it work but i keep getting a 'subscript out of range' error. The following line is highlighted in the debugger.

lrow1 = Workbooks(Dest).Sheets(1).Columns("A").Cells(Rows.Count).End(xlUp).Row + 1

This happens regardless of which sheet i select in the drop down. The appropriate workbook opens but nothing is copied before this error is shown. So close!
Can you please upload your file with the code in place so I can take a look... it seems to be working ok on my end.

Thank you
 
Can you please upload your file with the code in place so I can take a look... it seems to be working ok on my end.

Thank you

Thanks again for your help.

The files are attached, Hopefully its not something i have done to break it!
 

Attachments

  • Book 1.xlsx
    8.1 KB · Views: 7
  • Book 2.xlsx
    8.1 KB · Views: 6
  • Example.xlsm
    20.4 KB · Views: 8
Thanks again for your help.

The files are attached, Hopefully its not something i have done to break it!
Weird... I changed "C:" to "D:" and recreated the exact same path and it worked on first try.
It must be something else... try leaving only the "example" file open before clicking the button. If the problem persists try changing the path to something shorter like "C:\" and see if it works.
 
Weird... I changed "C:" to "D:" and recreated the exact same path and it worked on first try.
It must be something else... try leaving only the "example" file open before clicking the button. If the problem persists try changing the path to something shorter like "C:\" and see if it works.
Unfortunately still the same issue. Thank you so much for the help!

I can see it is nearly there as it does everything up to that point. I will continue to play around with some different locations and the code and see if i can get it to finalize.
 
Unfortunately still the same issue. Thank you so much for the help!

I can see it is nearly there as it does everything up to that point. I will continue to play around with some different locations and the code and see if i can get it to finalize.

It would be great if I could replicate the error... :(
If you can't figure it out in the weekend I will get back to this on Monday and hopefully we can sort something out.

Have a nice weekend :)
 
Good morning PCosta,

How was your weekend?

I have had a play around (changed sheet names, changed workbook names, moved the code into new workbooks, placed the files so that the file path was shorter etc) but still hit the same issue as described above.

Let me know if you need anything more from me to help, maybe some pics of the issue etc?

Many thanks for all your help again.
 
Good morning PCosta,

How was your weekend?

I have had a play around (changed sheet names, changed workbook names, moved the code into new workbooks, placed the files so that the file path was shorter etc) but still hit the same issue as described above.

Let me know if you need anything more from me to help, maybe some pics of the issue etc?

Many thanks for all your help again.
Hi,

I had a great weekend, thank you... how was yours?

About the problem, let's try forcing the code to resume after the error (this shouldn't solve the problem but may give us some more info about what is causing it):
Code:
Sub CopyPaste()

    On Error Resume Next

    Dim lrow, lrow1 As Integer
    Dim Path, Dest, Source As String
 
    Source = ActiveWorkbook.Name
    lrow = Workbooks(Source).Sheets("Calculations").Columns("A").Cells(Rows.Count).End(xlUp).Row
    Dest = Workbooks(Source).Sheets("Calculations").Range("B2").Value
    Path = "C:\Users\Thomas.Brooks\Desktop\Test Environment\Ideas for macro to copy and past data\OPtions\" & Dest & ".xlsx"
 
    Workbooks.Open Path
        lrow1 = Workbooks(Dest).Sheets(1).Columns("A").Cells(Rows.Count).End(xlUp).Row + 1
        Workbooks(Source).Sheets("Calculations").Range("A7:A" & lrow & "," & "C7:C" & lrow).Copy Workbooks(Dest).Sheets(1).Range("A" & lrow1)
    Workbooks(Dest).Close savechanges:=True

End Sub

Let me know what happens, thanks
 
Morning.

Mine was great, still recovering but that's always the sign of a good one.

I tried the new code and it stops the error from coming up. The appropriate sheets opens but nothing is copied onto it and it stays open. No error of any description is shown.

Is it about now that you are regretting responding to this one :DD
 
Morning.

Mine was great, still recovering but that's always the sign of a good one.

I tried the new code and it stops the error from coming up. The appropriate sheets opens but nothing is copied onto it and it stays open. No error of any description is shown.

Is it about now that you are regretting responding to this one :DD
Nah :)

It shouldn't throw any error since we forced it to resume... my ideia was to see if it could copy the data. The thing is, it should not be stooping where it is because it clearly was able to follow the path and open the file.

step 2 :): If you open Book 1 or Book 2 manually, does excel prompt you to enable editing? if so allow it and save the changes (repeat for the other file)

Then try the macro again and let me know the result

Thanks
 
So for book 1 it didn't ask to enable editing but for book 2 it did. I saved book 2 and ran the macro for both sheets again but still with the same issue that nothing is pasted.

I know i keep saying it but thanks for the help with this :)
 
So for book 1 it didn't ask to enable editing but for book 2 it did. I saved book 2 and ran the macro for both sheets again but still with the same issue that nothing is pasted.

I know i keep saying it but thanks for the help with this :)

Don't worry about it :)
Let's try it once with all 3 files open.
What happens then?
 
With all three open the same thing happens it brings the sheet that it is trying to copy to to the front but nothing is pasted.
 
The only thing I can think of is that for some reason your excel is opening the files in different instances instead of the same.

Open a new excel file and then try opening all 3 files through the File>Open option and then run the code.

On a side note, what is your version of Excel (Office)?
 
Well, last try :(

Try replacing with the following:
Code:
Sub CopyPaste()

    Dim lrow, lrow1 As Integer
    Dim Path, Dest, Source As String

    Source = ActiveWorkbook.Name
    lrow = Workbooks(Source).Sheets("Calculations").Columns("A").Cells(Rows.Count).End(xlUp).Row
    Dest = Workbooks(Source).Sheets("Calculations").Range("B2").Value
    Path = "C:\Users\Thomas.Brooks\Desktop\Test Environment\Ideas for macro to copy and past data\OPtions\" & Dest & ".xlsx"

    Workbooks.Open Path
        lrow1 = ActiveWorkbook.Sheets("A").Columns("A").Cells(Rows.Count).End(xlUp).Row + 1
        Workbooks(Source).Sheets("Calculations").Range("A7:A" & lrow & "," & "C7:C" & lrow).Copy ActiveWorkbook.Sheets("A").Range("A" & lrow1)
    Workbooks(Dest).Close savechanges:=True

End Sub

and replace previous book 1 and book 2 with the files attached

See if it works now
 

Attachments

  • Book 1.xlsx
    8.1 KB · Views: 8
  • Book 2.xlsx
    8.1 KB · Views: 6
Last edited:
Ok, so you have worked your magic on the copying and pasting :). When i run the new code it opens the correct workbook and pastes everything it should. I then get a 'subscript out of range' error with the following code showing up in the debugger

Workbooks(Dest).Close savechanges:=True

The workbook stays open.
 
Ok, so you have worked your magic on the copying and pasting :). When i run the new code it opens the correct workbook and pastes everything it should. I then get a 'subscript out of range' error with the following code showing up in the debugger

Workbooks(Dest).Close savechanges:=True

The workbook stays open.

Great :)
Now I see where the problem was... replace:
Code:
Workbooks(Dest).Close savechanges:=True
with
Code:
ActiveWorkbook.Close savechanges:=True

and you should be good to go.
 
It is still unclear to me why it breaks at "Workbooks(Dest)", even more so since it was able to use that variable in the path, but oh well... just glad it worked out in the end

I'm sorry it took so long to figure out :)
 
You sir have skills!! I could kiss you (now imagining some big hairy bloke that really hasn't appreciated that comment haha).

Thank you so much for all of your help, it really is appreciated.
 
Back
Top