Copy multiple ranges indicated by inputbox

Question

Until now I have a Macro to look up a year and copy that to a new sheet. However, I may want this for multiple years. My dataset is structured as follow:

Col A   Col B   Col C   Col D   ColE
Year    Week    Amount  time    forecast
2000    1       368     2000w1  400
2000    2       8646    2000w2  8500
until...
2014    52      46546   2014w52 47000

Until now, my macro is:

Sub Copyyear()
Dim Forecastyear As String
Dim Rng As Range
Dim cell As Range

Forecastyear = InputBox("Enter a year to forecast")

If Trim(Forecastyear) <> "" Then
    With Sheets(2)
        For Each cell In .Range("A:A")
            If cell.Value = Forecastyear Then 'find first occurrence of year
                Set Rng = cell
                Exit For
            End If
        Next
        '.Range(Rng.Address).Resize(52, 5).Select 'resize for 52 rows and 5 columns
        Rng.Resize(52, 5).Copy Destination:=Sheets("Moving Average").Range("A2")
    End With
End If

'   Record in new sheet
Worksheets("Moving Average").Select
    Range("A1").Value = "YEAR"
    Range("B1").Value = "WEEK"
    Range("C1").Value = "AMOUNT"
    Range("D1").Value = "TIME"
    Range("E1").Value = "FORECAST"

'   next macro
    AddForecastPerformance

End Sub

Answer 1

Use below. Years entered like 2001,2002,2003,2004 etc

Sub Copyyear()
Dim Forecastyear As String
Dim Rng As Range
Dim cell As Range

Forecastyear = InputBox("Enter year(s) to forecast, for multiple year input as 2001,2002,2003 etc")

If InStr(1, Forecastyear, ",") > 0 Then
    sp = Split(Forecastyear, ",")
    For i = 0 To UBound(sp)
        If Trim(sp(i)) <> "" Then
            With Sheets(2)
                For Each cell In .Range("A:A")
                    If cell.Value = CInt(sp(i)) Then 'find first occurrence of year
                        Set Rng = cell
                        Exit For
                    End If
                Next
                '.Range(Rng.Address).Resize(52, 5).Select 'resize for 52 rows and 5 columns
                Rng.Resize(52, 5).Copy Destination:=Sheets("Moving Average").Range("A2").Offset(0 + (52 * i), 0)
            End With
        End If
    Next
Else
    If Trim(Forecastyear) <> "" Then
        With Sheets(2)
            For Each cell In .Range("A:A")
                If cell.Value = Forecastyear Then 'find first occurrence of year
                    Set Rng = cell
                    Exit For
                End If
            Next
            '.Range(Rng.Address).Resize(52, 5).Select 'resize for 52 rows and 5 columns
            Rng.Resize(52, 5).Copy Destination:=Sheets("Moving Average").Range("A2")
        End With
    End If
End If

'   Record in new sheet
with Worksheets("Moving Average")
    .Range("A1").Value = "YEAR"
    .Range("B1").Value = "WEEK"
    .Range("C1").Value = "AMOUNT"
    .Range("D1").Value = "TIME"
    .Range("E1").Value = "FORECAST"
end with

'   next macro
    AddForecastPerformance

End Sub