Code simplification to cover all twelve worksheets - vba

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

Answer 1

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