Vba code to copy & paste values from one sheet to another if condition is met

K

Knight_777

New Member
Joined
Mar 6, 2018
Messages
7
Hi,
Below is a simplified example of tables I have. the 1st tab is in one sheet and the 2nd one is in a different sheet.
Basically what I wont to do is to write a VBA code to copy & paste the value shown in tab 1 to tab 2 in the 2nd sheet if one codition is met, which is the date. In other words, I wont to get the values from tab 1 to be copied in the 2nd tab (which has multiple columns) only if the date in the header of the column match the date as shown in the first cell "2018-03-09" of tab 1. But also, I don't want anything to be copied in the other columns if the criteria is not met, as there will be formulas in those columns which I want preserve if the date is not matching.

I know it sounds complicated, but thought it would be possible to do it through a code.

I would appreciate if anyone could help me on this one, as I'm new to VBA.


Thank you in advance.


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: right"]Today:[/TD]
[TD="align: center"]2018-03-09[/TD]
[/TR]
[TR]
[TD]Daily Road Tax Reserve (-)[/TD]
[TD]-225500[/TD]
[/TR]
[TR]
[TD]Road Tax Reserve Release (+)[/TD]
[TD]5000000[/TD]
[/TR]
[TR]
[TD]Excess Availability (-/+)[/TD]
[TD]-1600000[/TD]
[/TR]
[TR]
[TD]Account -1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Account -2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Account -3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Account -4[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]2018-03-05[/TD]
[TD]2018-03-06[/TD]
[TD]2018-03-07[/TD]
[TD]2018-03-08[/TD]
[TD]2018-03-09[/TD]
[TD]2018-03-10[/TD]
[TD]2018-03-11[/TD]
[TD]2018-03-12[/TD]
[TD]2018-03-13[/TD]
[/TR]
[TR]
[TD]Daily Road Tax Reserve (-)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Road Tax Reserve Release (+)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Excess Availability (-/+)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Account -1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Account -2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Account -3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Account -4[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] Total Collections[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
Make sure that cell B1 in Sheet1 is formatted as a date in the format "yyyy-mm-dd" and the same for the dates in Sheet2. Then try this macro:
Code: 
Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim strdate As String
    strdate = Sheets("Sheet1").Range("B1")
    Dim foundDate As Range
    Set foundDate = Sheets("Sheet2").Rows(1).Find(CDate(strdate), LookIn:=xlFormulas, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        Sheets("Sheet1").Range("B2:B" & LastRow).Copy Sheets("Sheet2").Cells(2, foundDate.Column)
    End If
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Make sure that cell B1 in Sheet1 is formatted as a date in the format "yyyy-mm-dd" and the same for the dates in Sheet2. Then try this macro:
Code: 
Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim strdate As String
    strdate = Sheets("Sheet1").Range("B1")
    Dim foundDate As Range
    Set foundDate = Sheets("Sheet2").Rows(1).Find(CDate(strdate), LookIn:=xlFormulas, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        Sheets("Sheet1").Range("B2:B" & LastRow).Copy Sheets("Sheet2").Cells(2, foundDate.Column)
    End If
    Application.ScreenUpdating = True
End Sub
Click to expand...


Thank you for the quick reply.
What should I change in the code to get the data copied and pasted as value only without altering the destination cells format?

Thanks
 
Upvote 0
mumps said:
Make sure that cell B1 in Sheet1 is formatted as a date in the format "yyyy-mm-dd" and the same for the dates in Sheet2. Then try this macro:
Code: 
Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim strdate As String
    strdate = Sheets("Sheet1").Range("B1")
    Dim foundDate As Range
    Set foundDate = Sheets("Sheet2").Rows(1).Find(CDate(strdate), LookIn:=xlFormulas, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        Sheets("Sheet1").Range("B2:B" & LastRow).Copy Sheets("Sheet2").Cells(2, foundDate.Column)
    End If
    Application.ScreenUpdating = True
End Sub
Click to expand...

Hi I tried the code but it's not working it breakdown at the below step

Sheets("Sheet1").Range("B2:B" & LastRow).Copy Sheets("Sheet2").Cells(2, foundDate.Column)


Thanks.
 
Upvote 0
This macro will paste only the values. Do you have two sheets named "Sheet1" and "Sheet2"? Have you formatted the cells that contain dates as a date in the format "yyyy-mm-dd"?
Code: 
Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim strdate As String
    strdate = Sheets("Sheet1").Range("B1")
    Dim foundDate As Range
    Set foundDate = Sheets("Sheet2").Rows(1).Find(CDate(strdate), LookIn:=xlFormulas, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        Sheets("Sheet1").Range("B2:B" & LastRow).Copy
        Sheets("Sheet2").Cells(2, foundDate.Column).PasteSpecial xlPasteValues
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
This macro will paste only the values. Do you have two sheets named "Sheet1" and "Sheet2"? Have you formatted the cells that contain dates as a date in the format "yyyy-mm-dd"?
Code: 
Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim strdate As String
    strdate = Sheets("Sheet1").Range("B1")
    Dim foundDate As Range
    Set foundDate = Sheets("Sheet2").Rows(1).Find(CDate(strdate), LookIn:=xlFormulas, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        Sheets("Sheet1").Range("B2:B" & LastRow).Copy
        Sheets("Sheet2").Cells(2, foundDate.Column).PasteSpecial xlPasteValues
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
Click to expand...


Hi, Thank you for the reply and sorry for being late in getting back to you.
Yes, I have used the format for the dates in both sheets.

Is there way I can share my spreadsheet with you, so you will see how the tables look like. Because I think I over simplified the file in my original post.

Thank you
 
Upvote 0
Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0
mumps said:
Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.
Click to expand...

Hi,
I have uploaded the file into dropbox and here is the link.

https://www.dropbox.com/s/qm57n1lec33n3b2/Daily Cash-Flow Template_Test.xlsm?dl=0


Thank you in advance
 
Upvote 0
Will the number of Items Affecting Availability (CIBC) always be the same (currently there are 5)? Will the number of Accounts always be the same (currently there are 11)? Will the number of Receipts from Other Sources always be the same (currently there are 6)?
 
Upvote 0
mumps said:
Will the number of Items Affecting Availability (CIBC) always be the same (currently there are 5)? Will the number of Accounts always be the same (currently there are 11)? Will the number of Receipts from Other Sources always be the same (currently there are 6)?
Click to expand...

Yes there should be no change. However, I've kept one blank line just in case for Items Affecting Availability (CIBC) and for Receipts from Other Sources, and it's in both sheets

Thanks
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Solved
VBA - Filter columns, cut/paste rows new sheet, pivot table
2
Replies
12
Views
298
Skyybot
Skyybot
I
  • Question Question
VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date
Replies
2
Views
929
Insurance Dave
I
H
  • Question Question
Macro to download zip, unpack and copy data
Replies
0
Views
712
HeinrichPaul
H
B
  • Solved
VBA code to copy a one cell and a range of cells in one column to another sheet
2
Replies
10
Views
262
Fluff
Fluff
V
  • Question Question
Copy and Paste Multiple sheet data in one sheet Formula
Replies
7
Views
335
vishu
V

Forum statistics

Threads
1,223,943
Messages
6,175,547
Members
452,652
Latest member
eduedu

Share this page

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