Code simplification to cover all twelve worksheets

Question

I've got this code that I need to simplify otherwise I'll have to copy it at least twelve times so as to cover the months of a year which would probably not be optimized. I am not too sure how to go about doing this.

Sub Test_Copy()

    Dim rng As Range
    Dim lastRow As Long
    With Worksheets("Sheet1")
        Set rng = .Range("B3", .Range("B" & .Rows.Count).End(xlUp))
    End With
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Rows(lastRow).Select
    With Worksheets("Mai")
        Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
        Worksheets("Mai").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    End With
    With Worksheets("Juin")
        Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
        Worksheets("Juin").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    End With
    With Worksheets("Juil")
        Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
        Worksheets("Juil").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    End With

End Sub

While you are waiting for an answer, see [How to avoid using Select in Excel VBA macros](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). — , Mar 11 '17 at 20:37

Dan Donoghue · Answer 1 · 2017-03-15T04:29:29.793

Firstly, you are using With incorrectly.

With Worksheets("Juin")
    Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
    Worksheets("Juin").Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End With

you would use it like this:

With Worksheets("Juin")
    .Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
End With

anything starting with . will automatically be against what you set as With. I am not sure if you want the selection doing, I would imagine you need to make a selection first but you haven't indicated what to select before inserting a row.

However, those problems aside, this will do what you want (but you still need to fix the select part of your With.

Sub Test_Copy()
    Dim rng As Range, lastRow As Long, MyMonth As Variant
    MyMonth = Array("Mai", "Juin", "Juil") ' Put more months in here
    Set rng = Worksheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Rows(lastRow).Select 'I "think" you want to do something with this for selecting within the sheet BUT lastrow is relevant only to the data in Sheet1
    For X = LBound(MyMonth) To UBound(MyMonth)
        With Worksheets(MyMonth(X))
            .Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
            .Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
        End With
    Next
End Sub

If however, you do not need to select a cell and insert then you can remove that with also and you end up with this:

Sub Test_Copy()
    Dim rng As Range, lastRow As Long, MyMonth As Variant
    MyMonth = Array("Mai", "Juin", "Juil") ' Put more months in here
    Set rng = Worksheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Rows(lastRow).Select 'I "think" you want to do something with this for selecting within the sheet BUT lastrow is relevant only to the data in Sheet1
    For X = LBound(MyMonth) To UBound(MyMonth)
        Worksheets(MyMonth(X)).Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    Next
End Sub

This doesn't insert anything, just writes from cell B6 onwards over the top of anything that is there.

Edited to your last comment:

Sub Test_Copy()
    Dim rng As Range, MyMonth As Variant
    MyMonth = Array("Mai", "Juin", "Juil") ' Put more months in here
    Set rng = Sheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
    For X = LBound(MyMonth) To UBound(MyMonth)
        Sheets(MyMonth(X)).Range("A" & .Cells(Rows.Count, 2).End(xlUp).Row).Resize(rng.Rows.Count, 1).EntireRow.Insert
        Sheets(MyMonth(X)).Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
    Next
End Sub

Lastly, there was another possibility without using the sheet array that I build in the code and you can use the worksheets object using For each WS in Worksheets, then you can use WS.blahblah to manipulate the sheet but you would need to put a test in there to make sure you don't hit the sheet you are copying from. Either way is technically acceptable.

That code would look something like this:

Sub Test_CopyWS()
    Dim rng As Range, WS As Worksheet
    Set rng = Sheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))
    For Each WS In Worksheets
        If Not ES.name = "Sheet1" Then
            WS.Range("A" & .Cells(Rows.Count, 2).End(xlUp).Row).Resize(rng.Rows.Count, 1).EntireRow.Insert
            WS.Range("B6").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
        End If
    Next
End Sub

Dan - You may have guessed that I am not very experienced with VBA but am learning. What I need to Select is the row before the last non empty row of the MyMonthly sheets. Then I need to insert a new row before the last non empty row and paste the format and formulas. Also note that I get a **Compile error: Invalid or unqualified reference** error for 'Set rng = Worksheets("Sheet1").Range("B3", .Range("B" & .Rows.Count).End(xlUp))' where .Rows is highlighted. — Bogey_One, Mar 13 '17 at 10:58
So something like worksheets(mymonth(x)).Range("A" & rows.count).End(xlup).Offset(-1,0).entirerow.insert (or something like that, apologies I am free typing on my phone. I can help more tomorrow if you need. — Dan Donoghue, Mar 13 '17 at 11:03
That would be fine and appreciated Dan. If you require, I may send you the workbook itself so as to put a picture on what I am trying to achieve. — Bogey_One, Mar 13 '17 at 14:12
OK Just tested, and it seems to work, Try this `Worksheets(MyMonth(X)).Range("B" & Rows.Count).End(XLup).Offset(0,0).Entirerow.Insert ` Put that in my code before as the first line in the For loop. I am not 100% sure why you have hard coded B6 in the next line though. Also get rid of the `.` at the start of `.rows.count` and change the `,` to `&` after `"B3"` to fix your other error. — Dan Donoghue, Mar 14 '17 at 00:59
Actually, the extra question is a bit of a mess, this should work, I assume you want the used range from col B? `Set rng = Worksheets("Sheet1").Range("B3:B" & Range("B" & .Rows.Count).End(xlUp).row)` — Dan Donoghue, Mar 14 '17 at 01:04
What it is actually doing is pasting the data from Sheet1 into all the monthly sheets starting at row B6 till the end. My last row in all the monthly sheets is a Totals line with formulas that I need to keep. So this is why I have to find out where this last row is and then paste the copied data from Sheet1 to the monthly sheets starting at B6 and before the last Totals row. — Bogey_One, Mar 14 '17 at 10:35
OK Change this `Rows(lastRow).Select` to `range("A" & lastRow).Resize(rng.Rows.Count,1).EntireRow.insert` and move both that line and the one above it into the For next loop (above the `worksheets(MyMonth.....` line I will add a modified version to my answer for you — Dan Donoghue, Mar 15 '17 at 04:18
I have added my current code in my initial post towards the end. Please note that it copies what is in Sheet1 to the monthly sheets but it is still squashing the last Totals row. It should paste everything above this last row starting at cell B6. — Bogey_One, Mar 15 '17 at 08:57

Code simplification to cover all twelve worksheets

1 Answers1