Macro record for correction

[Thomas Kuriakose]

Respected Sirs,

We would like to copy a range (B4:B2000) from summary sheet and paste to multiple sheets named month wise in cell A5. The number of rows would vary in the summary sheet from B4 per week.

I recorded the below macro -

Sub Copydata()
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.ScrollRow = 2108
    ActiveWindow.ScrollRow = 1997
    ActiveWindow.ScrollRow = 1899
    ActiveWindow.ScrollRow = 816
    ActiveWindow.ScrollRow = 310
    ActiveWindow.ScrollRow = 4
    Sheets("Apr").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A5").Select
    Sheets("May").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A5").Select
    Sheets("Jun").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A5").Select
    Sheets("Jul").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A5").Select
    Sheets("Aug").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A5").Select
    Sheets("Sep").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A5").Select
    Sheets("Oct").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A5").Select
    Sheets("Nov").Select
    Range("A5").Select
    ActiveSheet.Paste
    Sheets("Dec").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A5").Select
    Sheets("Jan").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A5").Select
    Sheets("Feb").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A5").Select
    Sheets("Mar").Select
    Range("A5").Select
    ActiveSheet.Paste
    Range("A5").Select
    Sheets("Summary").Select
    Range("B3").Select
    Application.CutCopyMode = False
End Sub

Kindly guide on how to get this shortened and select the actual number of rows with data and copy to all the sheets named month wise.

There are other sheets also in the workbook,

Thank you very much for your kind support and guidance always,

with regards,
thomas

 

[Stevie]

Hi Thomas,
please try the below:

Sub Thomas()
    Dim mnths As Variant, mnth As Variant, length As Double, copyrange As Range
    length = Sheets("Summary").Cells(Sheets("Summary").Rows.Count, 2).End(xlUp).Row
    Set copyrange = Sheets("Summary").Range("B4:B" & length)
    mnths = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    For Each mnth In mnths
        Sheets(mnth).Range("A5:A" & length + 1) = copyrange.Value
    Next
End Sub

If this was useful, please click 'Like!' in the bottom right.

Stevie ^.^

 

[Thomas Kuriakose]

Respected Sir,

This worked perfectly, thank you so much for the solution and your support on this query,

very much appreciated,

with regards,
thomas