VBA Copy range values and paste in another sheet

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

2018

Sheet1

Userformdata

Upvotes: 0

Views: 2471

Answers (2)

paul bica
paul bica

Reputation: 10715

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

Upvotes: 1

Slai
Slai

Reputation: 22876

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)") & " ), """")"

Upvotes: 0

Related Questions