Thread: Macros for copying the next month

I would like to learn how to write a macros that will take a set of cells with the names of hospital units and copy them down with the next corresponding month. Please see attachment for example. The macros code doesn't repeat the action for the next months. Here is my code:

 ActiveWindow.SmallScroll Down:=-4
    Range("A23:B43").Select
    Selection.Copy
    Range("A23:S43").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A44").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=9
End Sub

Used it the marcos recorder.

THis should do it, it will ask you how many new months you want to add, then it will extend the range that many months incrementing from the last date in column B. Formatting is preserved as well. Any data you may have entered into the table in the existing months will not be transferred if it exists.

Option Explicit

Sub ExtendListXmonths()
Dim Months As Long
Dim Mth    As Long
Dim NR     As Long
Dim HspRNG As Range
Dim fDate  As Date

Months = Application.InputBox("Extend existing list how many months?", "Repitition", Type:=1)
If Months = 0 Then Exit Sub

With ActiveSheet
    Set HspRNG = .Range("A2:A22")
    fDate = .Range("B" & .Rows.Count).End(xlUp)
    NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    
    For Mth = 1 To Months
        .Range("A" & NR).Resize(HspRNG.Cells.Count).Value = HspRNG.Value
        .Range("B" & NR).Resize(HspRNG.Cells.Count).Value = _
                DateSerial(Year(fDate), Month(fDate) + Mth, 1)
        HspRNG.Resize(, 26).Copy
        .Range("A" & NR).Resize(HspRNG.Cells.Count).Resize(, 26).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        NR = NR + HspRNG.Cells.Count
    Next Mth
End With

End Sub

If that takes care of your need, please click EDIT in your original post, click GO ADVANCED and set the PREFIX box to SOLVED.