VBA Copy range values and paste in another sheet

Question

I have made a program, that allows the user to enter the year and team, that they are on. It print the values to a data sheet. When the user click on a commandbutton, the code will print the values to a calendar. My question is, can this be made smarter?

If Worksheets("DATA").Range("B2").Value = "2018" And Worksheets("DATA").Range("B3").Value = "Team 3" Then
'January
    Worksheets("Sheet1").Range("J4:J34").Copy
    Worksheets("2018").Range("D3:D33").PasteSpecial xlValues
'February
    Worksheets("Sheet1").Range("J35:J62").Copy
    Worksheets("2018").Range("H3:H33").PasteSpecial xlValues
'March
    Worksheets("Sheet1").Range("J63:J93").Copy
    Worksheets("2018").Range("L3:L33").PasteSpecial xlValues
'April
    Worksheets("Sheet1").Range("J94:J123").Copy
    Worksheets("2018").Range("P3:P33").PasteSpecial xlValues
'May
    Worksheets("Sheet1").Range("J124:J154").Copy
    Worksheets("2018").Range("T3:T33").PasteSpecial xlValues
'June
    Worksheets("Sheet1").Range("J155:J184").Copy
    Worksheets("2018").Range("X3:X33").PasteSpecial xlValues
'July
    Worksheets("Sheet1").Range("J185:J215").Copy
    Worksheets("2018").Range("AB3:AB33").PasteSpecial xlValues
'August
    Worksheets("Sheet1").Range("J216:J246").Copy
    Worksheets("2018").Range("AF3:AF33").PasteSpecial xlValues
'September
    Worksheets("Sheet1").Range("J247:J276").Copy
    Worksheets("2018").Range("AJ3:AJ33").PasteSpecial xlValues
'October
    Worksheets("Sheet1").Range("J277:J307").Copy
    Worksheets("2018").Range("AN3:AN33").PasteSpecial xlValues
'November
    Worksheets("Sheet1").Range("J308:J337").Copy
    Worksheets("2018").Range("AR3:AR33").PasteSpecial xlValues
'December
    Worksheets("Sheet1").Range("J338:J368").Copy
    Worksheets("2018").Range("AV3:AV33").PasteSpecial xlValues
End If

On the Sheet1 sheet, the dates are listed in C

Almost everything can be made smarter, if there is enough details about the data layout to pick up patterns etc. — PatricK
– PatricK, Commented Mar 22, 2018 at 0:24
@paulbica i want to copy the value of ex the values of january in Sheet1 'Team 1 A' to 2018 H3:H33 and february sheet1 'Team 1 A' to L3:33 to sheet '2018' etc. — Claus Thaulov Skeel Kristensen
– Claus Thaulov Skeel Kristensen, Commented Mar 22, 2018 at 1:39
I can see what your code is doing, I'm asking specifically about the July copy action: ("Sheet1").Range("J185:J215").Copy: ("2018").Range("AB3:AF33").PasteSpecial (copy to AB3:AF33 - 4 columns) — paul bica
– paul bica, Commented Mar 22, 2018 at 1:44
@paulbica No that's a mistake, sorry :-) - it's supposed to be AB3:AB33 - I have attached the 2018 sheet as well — Claus Thaulov Skeel Kristensen
– Claus Thaulov Skeel Kristensen, Commented Mar 22, 2018 at 1:50

paul bica · Accepted Answer · 2018-03-28 16:16:15Z

1

You can try to make it easier to update the ranges to be copied (mapping):

Option Explicit

Public Sub CopyData()
    Const START_ROW = 3

    If ThisWorkbook.Worksheets("DATA").Range("B2").Value = "2018" And _
       ThisWorkbook.Worksheets("DATA").Range("B3").Value = "Team 3" Then

        Dim yr As Object, ws1 As Worksheet, ws2 As Worksheet

        Set ws1 = ThisWorkbook.Worksheets("Sheet1")
        Set ws2 = ThisWorkbook.Worksheets("2018")

        Set yr = CreateObject("Scripting.Dictionary")
        yr("J4:J34") = "D"      'Jan
        yr("J35:J62") = "H"     'Feb
        yr("J63:J93") = "L"     'Mar
        yr("J94:J123") = "P"    'Apr
        yr("J124:J154") = "T"   'May
        yr("J155:J184") = "X"   'Jun
        yr("J185:J215") = "AB"  'Jul
        yr("J216:J246") = "AF"  'Aug
        yr("J247:J276") = "AJ"  'Sep
        yr("J277:J307") = "AN"  'Oct
        yr("J308:J337") = "AR"  'Nov
        yr("J338:J368") = "AV"  'Dec

        Dim mnth As Variant, arr As Variant, toRng As String
        For Each mnth In yr
            arr = ws1.Range(mnth)
            toRng = yr(mnth) & START_ROW & ":" & yr(mnth) & UBound(arr) + START_ROW - 1
            ws2.Range(toRng) = arr
        Next mnth
    End If
End Sub

This is not ideal because there are still hard-coded values for all ranges but the columns are not the same size and I can't see the pattern for that

edited Mar 28, 2018 at 16:16

answered Mar 22, 2018 at 1:57

paul bica

10.8k4 gold badges27 silver badges45 bronze badges

Sign up to request clarification or add additional context in comments.

9 Comments

Claus Thaulov Skeel Kristensen Over a year ago

it looks great, but dosen't paste any values in the 2018 sheet.

paul bica Over a year ago

Not sure what the issue is; I created a new file with 3 sheets - Sheet1, DATA, and 2018, ran your code and it worked, then created the new code and it worked as well. You may need to step through the code and monitor the variables in the For loop

Claus Thaulov Skeel Kristensen Over a year ago

Lol it works now, i made an error. Thank you so much for your help!

paul bica Over a year ago

I’m glad you worked it out. If you give me the details of the error you had I can append it to my answer so others can avoid it

paul bica Over a year ago

I made an important update that will be easier to maintain in the long run by removing all hard-coded ranges

|

Slai · Accepted Answer · 2018-03-22 13:55:02Z

0

Because date and time in Excel is stored as a number of days, the source row can be found with:

=Date(2018, Column() / 4, Row()) - Date(2018, 1, -1)

and the source column index with:

=Match(Data!B3 & "*", '2018'!3:3, 0)

and combined in VBA:

y = [DATA!B2]

Sheet1.[3:33 (D:D,H:H,L:L,P:P,T:T,X:X,AB:AB,AF:AF,AJ:AJ,AN:AN,AR:AR,AV:AV)].Formula = _
    "=If(C3, Index('" & y & "'!$A:$Z, Date(" & y & ", Column() / 4, Row()) - Date(" & y _
    & ", 1, -1), " & Evaluate("Match(DATA!B3 & ""*"", '" & y & "'!3:3, 0)") & " ), """")"

edited Mar 22, 2018 at 13:55

answered Mar 22, 2018 at 4:55

Slai

23k5 gold badges49 silver badges55 bronze badges

2 Comments

Claus Thaulov Skeel Kristensen Over a year ago

correct me if i’m wrong, but this code includes the year, so if i for example, continued the plan in sheet1 to 2019, by just dragging the down, it wouldn’t be a problem?

Slai Over a year ago

@ClausThaulovSkeelKristensen if 2019 is on the same Sheet1 after column AV and you have a "2019" sheet, you can try y = 2019 and updating the column ranges that are before )].Formula

Collectives™ on Stack Overflow

VBA Copy range values and paste in another sheet

2 Answers 2

9 Comments

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

9 Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related