VBA Adding copied rows after last used row

[yttgle]

Hi experts!

I have a worksheet which always has data in the A column (as part of a merged cell).

I am looking for a VBA program to help me select the last row and add a copyed set of 4 rows to add after the last row. The copyed selection will always be the same and origin from the same cells.

E.g.
- Select last used row (61 or Cell A61 as an example).
- Copy A1:F4 from different sheet
- Add copyed content to row 62:62 (A62:F65)

Next macro execution would add the same content to 66 etc.

Any way of solving this?

Br and thx!

 

[mole999]

what are your sheet names

 

[yttgle]

The main sheet is 'DeliveryPlan' and the copy source is 'Source'

 

[mole999]

Something like this should work

Sub test()
Sheets("DeliveryPlan").Select
Dim LR As Long
LR = Sheets("DeliveryPlan").Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
Sheets("source").Range("A1:F4").Copy Destination:=Sheets("DeliveryPlan").Range("A" & LR)
End Sub

 

[yttgle]

Thx. I get no error when I run it but it does not produce anything either. There is no data in A1 does that matter? the first data in A colum occurs at row 7. However, there will always be data in the last row (as part of a merged cell A through F), this is also true for the copyed 4 rows (Row 4 in 'Source')

 

[mole999]

scroll down the sheet some ways, it maybe placing further down than you expect, its looking for special cells and if something is active lower down it could be there

 

[yttgle]

You are absolutely right Found them at ~700. It works like a charm - just not in the right place. I have completely formated all cells below my active content, why does it keep adding it down there? It also increments by 4 each time I run it. So now it added to 730-733, next 734-737 etc.

 

[mole999]

replace
'LR = Sheets("DeliveryPlan").Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
with
LR = Cells.Find(What:="*", After:=[A7], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

its going down that far as the cells above have been used at some time and its recognising that

clear below A7 (or your last valid set) down and restart

I thought you had four rows to add, so that what it is doing Copy A1:F4 from different sheet

 

[yttgle]

The previous one worked better, with the replacement it overwrites whatever is allready existing at A7:F10. Get the part about the other one looking for any previously used cells.

Sub test()
Sheets("DeliveryPlan").Select
Dim LR As Long
LR = Cells.Find(What:="*", After:=[A7], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Sheets("Source").Range("A1:F4").Copy Destination:=Sheets("DeliveryPlan").Range("A" & LR)
End Sub

Removed some content and added a screenshot below of the set-up. The 4 rows to be copyed are equal to this just in the other sheet.

Makes any sense?

 

[mole999]

'A7' looks blank to me, change to 'B'

also change to

LR = Range("B65536").End(xlUp).Row + 1