Macro Help

Pumper

New Member
Joined
Sep 12, 2013
Messages
46
Hi Everyone,

I am trying to update my macro so the data in column B (tab name “Checks”) is copied to another tab (“DATA”) into column B also. What I need is for that same data to be cut and pasted 3 times on a Monday when I run it (so it’s the same numbers for Fri/Sat/Sun) once every other day.

Any help is much appreciated

 

Some videos you may like

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

mrmmickle1

Well-known Member
Joined
May 11, 2012
Messages
2,456
This could probably be a little more concise but it should get the job done.

Code:
[COLOR=#0000ff]Sub[/COLOR] CopyBasedOnDate()


    [COLOR=#0000ff]Dim[/COLOR] TodaysDate    [COLOR=#0000ff]As Integer[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] CheckLastrow  [COLOR=#0000ff]As Integer[/COLOR]
    [COLOR=#0000ff]Dim[/COLOR] DataLastRow   [COLOR=#0000ff]As Integer[/COLOR]
   [COLOR=#0000ff] Dim[/COLOR] i             [COLOR=#0000ff]As Integer[/COLOR]
    
    TodaysDate = Weekday(Date, vbMonday)[COLOR=#008000] 'Determine the Day of Week, 1 = Monday[/COLOR]
  [COLOR=#0000ff]  If [/COLOR]TodaysDate = 1 [COLOR=#0000ff]Then[/COLOR]
    
       [COLOR=#0000ff] For[/COLOR] i = 1 [COLOR=#0000ff]To[/COLOR] 3 [COLOR=#0000ff]Step[/COLOR] 1
            CheckLastrow = Sheets("Checks").Range("B" & Rows.Count).End(xlUp).Row
            Sheets("Checks").Range("B1:B" & CheckLastrow).Copy
            DataLastRow = Sheets("Data").Range("B" & Rows.Count).End(xlUp).Row
            Sheets("Data").Range("B" & DataLastRow + 1).Select
            ActiveSheet.Paste
        [COLOR=#0000ff] Next [/COLOR]i
    
[COLOR=#0000ff]           Else
[/COLOR]  
        CheckLastrow = Sheets("Checks").Range("B" & Rows.Count).End(xlUp).Row
        Range("B1:B" & CheckLastrow).Copy
        DataLastRow = Sheets("Data").Range("B" & Rows.Count).End(xlUp).Row
        Sheets("Data").Range("B" & DataLastRow + 1).Select
        ActiveSheet.Paste


[COLOR=#0000ff]    End If[/COLOR]

[COLOR=#0000ff]End Sub[/COLOR]
 

Pumper

New Member
Joined
Sep 12, 2013
Messages
46
Thanks for your help mrmmickle1

That is enough for me to work with, appreciate your time and effort

 

mrmmickle1

Well-known Member
Joined
May 11, 2012
Messages
2,456
Glad to help. Let me know if you have any additional questions or need adjustments.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,518
Messages
5,529,311
Members
409,862
Latest member
lbisacca
Top