Good afternoon,
I have five sheets, let's just say their names are “Name1” ... “Name5” for instance. I enter data ONLY into sheet “Name1” in columns “E:U” twice weekly.
In sheet “Name1” I want to find the last cell with data in column “U”, then go up one row and one column to the right and copy from that cell to the last cell with data in to the right in that row + 1 down to the next row, then place the cursor in the cell one row down in column “E” which will be the first blank cell after data, and finally then shift the worksheet up one row.
The code below is my attempt for sheet "Name1" & "Name2" and as you can see is pretty useless for the fact that it is hard coded and needs to be adjusted EVERY time and does not work properly.
Option Explicit
Option Base 1
Sub Main()
Dim FindBlankCell As Range
Dim FindBlankOther As Range
Set FindBlankCell = Range("E" & Rows.Count).End(xlUp).Offset(1, 0)
Set FindBlankOther = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
With Sheets("Name1").Select
FindBlankCell.Activate
FindBlankCell.Offset(-1, 17).Select
Range("V1690:IM1690").Select
Selection.Copy
Range("V1691:IM1691").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=1
FindBlankCell.Activate
With Sheets("Name2").Select
FindBlankOther.Activate
FindBlankOther.Offset(-1, 0).Select
Range("B1690:HY1690").Select
Selection.Copy
Range("B1691:HY1691").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=1
FindBlankOther.Activate
End With
End With
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub
In sheets “Name2” to “Name5” I want to find the last cell with data in column “B” and copy from that cell to the last cell with data in to the right in that row + 1 down to the next row, then place the cursor in the cell one row down in column “B” which will be the first blank cell after data, and finally then shift the worksheet up one row.
At the moment I manually highlight these cells and drag the highlighted cells down one row etc.
Thanks in advance.
Kind regards,
PAB
Edited for correction of data.