Copy and pasting specific cells from one workbook to another through a button [VBA]

lakshman

New Member
Joined
May 22, 2017
Messages
14
Hi everyone. I am really new to Excel VBA and I am trying to automate some processes at work.

Before we push out our products, I use workbook A (Source & the active workbook) to generate charts based on bloomberg data and given parameters which are keyed in. These parameters are keyed into specific cells. IF the products are pushed out, the parameters need to be keyed in accordingly in another workbook B (Destination & the tracker workbook). Workbook B takes those parameters and tracks the changes in the asset prices in bloomberg.

1) C5 from workbook A needs to be pasted into the last empty cell in the column A (A97 now) in workbook B
2) C16 from workbook A needs to be pasted into the last empty cell in column C (C97 now) in workbook B
3) C10 from workbook A needs to be pasted into the last empty cell in the column D (D97 now) in workbook B
4) C8 from workbook A needs to be pasted into the last empty cell in the column F (F97 now) in workbook B
5) C7 from workbook A needs to be pasted into the last empty cell in the column H (H97 now) in workbook B

I did a trial to execute the first action and here is my code.

Code:
[HR][/HR][I]
Sub CopyPasteForTracker2017Q2()[/I]

[I]Dim TrackerBook As Workbook[/I]
[I]Dim CLastFundRow As Integer[/I]
[I]Dim CFirstBlankRow As Integer[/I]
[I]Dim wksSource As Worksheet, wksDest As Worksheet[/I]
[I]Dim rngStart As Range, rngDest As Range[/I]
[I]Dim SourceCell As Range[/I]

[I]'## Open both workbooks first:[/I]
[I]Set TrackerBook = Workbooks.Open(" F:\PB Mktg\Bloomberg\bloomberg13\TEST Product Ideas Performance Tracking Q2-17.xlsx ")[/I]
[I]Set wksDest = TrackerBook.Sheets("KOELN (Intra-day)")[/I]
[I]Set wksSource = ActiveWorkbook.Sheets("KO-ELN")[/I]

[I]'Finds last row of content[/I]
[I]    CLastFundRow = wksDest.Range("A1").End(xlDown).Row[/I]

[I]'Finds first row without content[/I]
[I]    CFirstBlankRow = CLastFundRow + 1[/I]

[I]'Copy Data[/I]
[I]    Set SourceCell = wksSource.Cells("C5")[/I]
[I]    SourceCell.Copy[/I]

[I]'Paste Data Values[/I]
[I]    Set rngDest = wksDest.Cells("A1" & CLastBlankRow)[/I]
[I]    rngDest.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False[/I]

[I]End Sub
[/I][HR][/HR]


Somehow, the code gives me an object defined error 1004. I may be using the variables incorrectly. I would really love to automate those 5 steps as it would save me and my team a lot of time. I would really appreciate any help that you guys can provide! Thank you.
 
Last edited by a moderator:

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Welcome to MrExcel,

Which line of code is highlighted when you get the error 1004 message and go to the VB Editor?

There's a few potential problems...

1. There probably shouldn't be a space before the "F:" in this reference...

Code:
Set TrackerBook = Workbooks.Open(" F:\PB Mktg\Bloomberg\bloomberg13\TEST Product Ideas Performance Tracking Q2-17.xlsx ")


2. CLastBlankRow isn't declared or assigned a value. I think you meant this to be CFirstBlankRow.
Code:
'Paste Data Values
 Set rngDest = wksDest.Cells("A1" & CLastBlankRow)

3. In same code above, even with that change in variables, the syntax is incorrect. If CFirstBlankRow is 97 then you could reference the desired destination using either of these statements:

Code:
 Set rngDest = wksDest.Cells(CFirstBlankRow, "A")

Code:
 Set rngDest = wksDest.Range("A:" & CFirstBlankRow)
 
Upvote 0
Hi. Thank you for replying. I am so thankful the online community is really helpful especially to super amateurs like me.

I don't see any highlighted code. I followed your instructions and the code is able to open the TrackerBook but it later gives me a "Runtime Error 9 - Subscript Out of Range". How can I proceed further?
 
Upvote 0
Hi just an update. I learnt you can find out the highlights using F8. I have also modified the code as best as I can to push the highlight as down as possible.

Code:
[I]Sub CopyPasteForTracker2017Q2()[/I]

[I]Dim TrackerBook As Workbook[/I]
[I]Dim CLastFundRow As Integer[/I]
[I]Dim CFirstBlankRow As Integer[/I]
[I]Dim wksSource As Worksheet, wksDest As Worksheet[/I]
[I]Dim rngStart As Range, rngDest As Range[/I]
[I]Dim SourceCell As Range[/I]

[I]'Copy Data[/I]
[I]    Set wksSource = ActiveWorkbook.Sheets("KO-ELN")[/I]
[I]    Set SourceCell = wksSource.Range("C5")[/I]
[I]    SourceCell.Copy[/I]

[I]'## Open both workbooks first:[/I]
[I]Set TrackerBook = Workbooks.Open("F:\PB Mktg\Bloomberg\bloomberg13\Automation Project\TEST Product Ideas Performance Tracking Q2-17.xlsx")[/I]
[I]Set wksDest = TrackerBook.Sheets("KOELN (Intra-day)")[/I]

[I]'Finds last row of content[/I]
[I]    CLastFundRow = wksDest.Range("A1").End(xlDown).Row[/I]

[I]'Finds first row without content[/I]
[I]    CFirstBlankRow = CLastFundRow + 1[/I]

[I]'Paste Data Values[/I]
[I]     Set rngDest = wksDest.Cells(CFirstBlankRow, "A")[/I]
[I]    rngDest.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False[/I]

[I]End Sub[/I]
The highlight comes at "rngDest.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False". It says object defined error 1004.
 
Last edited by a moderator:
Upvote 0
Glad to see you making progress on this. F8 can be very helpful at stepping through the execution of each line of code. Alternatively, when the error dialog appears, one of the buttons should be "Debug". If you click that button it should take you to the highlighted statement that was being executed when the error arose.

The problem with your current code is that the data is pasted to the clipboard on this statement....
Code:
SourceCell.Copy

...but then the clipboard is cleared when the TrackerBook workbook is opened.

Try moving the Copy statement(s) to just above the statement that pastes the values.

btw, There are more efficient ways to transfer values from one range to another. Since you're just copying a few values, the difference wouldn't be noticeable, and it's good that you sort out how to Copy-Paste before learning other methods.
 
Last edited:
Upvote 0
Hey! I have modified my code and it works without any error now (such a relief that even someone like me can do this). However the problem now is that the copied cell C5 is correct. But the pasted cell should be A97 which is the last blank row on column A. Instead, it pastes it on cell A4. There is something wrong with the last blank row code but I cannot figure it out. This should be last step of my trial. I would really appreciate any help you can provide. Thank you so much for guiding me thus far.

Here is the code:

Code:
Sub CopyPasteForTracker2017Q2()


Dim TrackerBook As Workbook
Dim CLastFundRow As Integer
Dim CFirstBlankRow As Integer
Dim wksSource As Worksheet, wksDest As Worksheet
Dim rngStart As Range, rngDest As Range
Dim SourceCell As Range
    
'## Open both workbooks first:


'Copy Data
Workbooks("Write Up + Tracker Prototype.xlsm").Activate
Set wksSource = ActiveWorkbook.Sheets("KO-ELN")
Set SourceCell = wksSource.Range("C5")
    SourceCell.Copy


'Paste Data Values
Set TrackerBook = Workbooks("TEST Product Ideas Performance Tracking Q2-17.xlsx")
TrackerBook.Activate
Set wksDest = TrackerBook.Sheets("KOELN (Intra-day)")


    CLastFundRow = wksDest.Range("A1").End(xlDown).Row


    CFirstBlankRow = CLastFundRow + 1
    
Set rngDest = wksDest.Cells(CFirstBlankRow, "A")
    rngDest.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


End Sub
 
Last edited by a moderator:
Upvote 0
Sorry quick update. I tested the same code on an empty new workbook (TEST.xlsx) with just random values on the first 20 cells. The code works perfectly and pastes the value into A21 (the last empty cell in this workbook). Why does it not work similarly in the other workbook?
 
Upvote 0
Your current uses (xlDown) which won't find the last row of data if there are any blanks in Column A. This is equivalent to selecting A1, then keying Ctrl + Down arrow.

Try using (xlUp) as shown below, which is equivalent to selecting the last cell in Column A, then keying Ctrl + Up arrow.

Code:
 With wksDest
   CLastFundRow = .Cells(.Rows.Count, "A").End(xlUp).Row
 End With

btw, when posting code, please use "code tags" which preserve the indenting of your code making it easier for others to read. You can add code tags by selecting your code, then clicking the "#" button in the Reply toolbar.
 
Upvote 0
Thank you so much for all your help. I have finally done it phew. I am sorry I didn't know how to use those code tags. I should have asked about it. Thanks to you, this is how my wonderful code looks like:

Code:
Sub CopyPasteForTracker2017Q2()


Dim TrackerBook As Workbook
Dim CLastFundRow As Integer
Dim CFirstBlankRow As Integer
Dim wksSource As Worksheet, wksDest As Worksheet
Dim rngStart As Range, rngDest As Range
Dim SourceCell As Range
    
'## Open both workbooks first:


'Copy Ticker
Workbooks("Write Up + Tracker Prototype.xlsm").Activate
Set wksSource = ActiveWorkbook.Sheets("KO-ELN")
Set SourceCell = wksSource.Range("C5")
    SourceCell.Copy


'Paste Data Values
Set TrackerBook = Workbooks("TEST Product Ideas Performance Tracking Q2-17.xlsx")
TrackerBook.Activate
Set wksDest = TrackerBook.Sheets("KOELN (Intra-day)")


With wksDest
    CLastFundRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
 
    CFirstBlankRow = CLastFundRow + 1
    
Set rngDest = wksDest.Cells(CFirstBlankRow, "A")
    rngDest.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
'Copy Trade Date
Workbooks("Write Up + Tracker Prototype.xlsm").Activate
Set wksSource = ActiveWorkbook.Sheets("KO-ELN")
Set SourceCell = wksSource.Range("C16")
    SourceCell.Copy


'Paste Data Values
Set TrackerBook = Workbooks("TEST Product Ideas Performance Tracking Q2-17.xlsx")
TrackerBook.Activate
Set wksDest = TrackerBook.Sheets("KOELN (Intra-day)")


With wksDest
    CLastFundRow = .Cells(.Rows.Count, "C").End(xlUp).Row
End With
 
    CFirstBlankRow = CLastFundRow + 1
    
Set rngDest = wksDest.Cells(CFirstBlankRow, "C")
    rngDest.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
'Copy Final Valuation Date
Workbooks("Write Up + Tracker Prototype.xlsm").Activate
Set wksSource = ActiveWorkbook.Sheets("KO-ELN")
Set SourceCell = wksSource.Range("C10")
    SourceCell.Copy


'Paste Data Values
Set TrackerBook = Workbooks("TEST Product Ideas Performance Tracking Q2-17.xlsx")
TrackerBook.Activate
Set wksDest = TrackerBook.Sheets("KOELN (Intra-day)")


With wksDest
    CLastFundRow = .Cells(.Rows.Count, "D").End(xlUp).Row
End With
 
    CFirstBlankRow = CLastFundRow + 1
    
Set rngDest = wksDest.Cells(CFirstBlankRow, "D")
    rngDest.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
'Copy Strike
Workbooks("Write Up + Tracker Prototype.xlsm").Activate
Set wksSource = ActiveWorkbook.Sheets("KO-ELN")
Set SourceCell = wksSource.Range("C7")
    SourceCell.Copy


'Paste Data Values
Set TrackerBook = Workbooks("TEST Product Ideas Performance Tracking Q2-17.xlsx")
TrackerBook.Activate
Set wksDest = TrackerBook.Sheets("KOELN (Intra-day)")


With wksDest
    CLastFundRow = .Cells(.Rows.Count, "H").End(xlUp).Row
End With
 
    CFirstBlankRow = CLastFundRow + 1
    
Set rngDest = wksDest.Cells(CFirstBlankRow, "H")
    rngDest.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    


End Sub
 
Upvote 0

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

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