Thanks MD,
I have adapted the code slightly and the only thing that does NOT work is ...
Cel.Offset(1, 0).Select
ActiveWindow.SmallScroll Down:=1
... in the MyArray code which goes to the first empty cell in "B" for each and scrolls the sheet up one line for each.
Here is the adapted code ...
Option Explicit
Option Base 1
Sub Automate()
Dim MyArray As Variant
Dim Cel As Range
Dim sh As Worksheet
MyArray = Array("Name2", "Name3", "Name4", "Name5")
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
With Sheets("Name1")
Set Cel = .Range("E" & Rows.Count).End(xlUp).Offset(-1, 17)
Range(Cel, .Cells(Cel.Row, Columns.Count).End(xlToLeft)).Resize(2).FillDown
Cel.Offset(2, -17).Select
ActiveWindow.SmallScroll Down:=1
End With
For Each sh In Sheets(MyArray)
Set Cel = sh.Range("B" & Rows.Count).End(xlUp)
Range(Cel, sh.Cells(Cel.Row, Columns.Count).End(xlToLeft)).Resize(2).FillDown
Cel.Offset(1, 0).Select
ActiveWindow.SmallScroll Down:=1
Next
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub
Thanks in advance.
Kind regards,
PAB