Duplicate last row and other progressive numbers

[JohnBi]

Hallo to everybody.
I found in Internet the following Vba code that works Ok, but I would like to modify as follows if possible as I am not very good with VBA
- instead of copy range A23:J23, and insert after the last row, copy Alastrow:Jlastrow and insert in the below row (for example from 25 to 26; then from 26 to 27, etc.
- in the cell D add a progressive number: if for example row 25, Cell D has 11, when copied to to row 26, cell D should have 12 and so on; when copied of row 27, cell D=13

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim NextCell As Range
Dim LastRow As Integer

Set WB = ActiveWorkbook
Set SH = WB.Sheets("UK")
Set rng = SH.Range("A23:J23")

Set NextCell = SH.Cells(Rows.Count, "A").End(xlUp)(2)

rng.Copy Destination:=NextCell

End Sub

I hope I have been able to explain what I would like to have.
Thanks for your much appreciate help.
Regards
John



--------------= Posted using GrabIt =----------------
------= Binary Usenet downloading made easy =---------
-= Get GrabIt for free from http://www.shemes.com/ =-

 

[isabelle]

hi John,

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim LastRow As Long

Set WB = ActiveWorkbook
Set SH = WB.Sheets("UK")

With SH
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
..Range(.Cells(LastRow, 1), .Cells(LastRow, 10)).AutoFill
Destination:=.Range(.Cells(LastRow, 1), .Cells(LastRow + 1, 10)),
Type:=xlFillDefault
End With
End Sub


isabelle

 

[John]

Hi Isabelle,
many thanks this perfect.
Thanks again.
Regards
gbianchi

 

[John]

Il 05/01/2013 17:30, isabelle ha scritto:

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim LastRow As Long

Set WB = ActiveWorkbook
Set SH = WB.Sheets("UK")

With SH
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(LastRow, 1), .Cells(LastRow, 10)).AutoFill
Destination:=.Range(.Cells(LastRow, 1), .Cells(LastRow + 1, 10)),
Type:=xlFillDefault
End With
End Sub

Hallo,
the vba code is Ok; however, If I have a number on column G, ie 79560,
after the execution of the code I have 79561, 79562 and so on. It should
be always the same 79560.
I try to change Type:xlFillDefaul to Type:xlFillCopy but the progressive
number in column D is not anymore update and remain exactly as the
previous row.
Any suggestion is much appreciate.
Thanks and Regards
John


The code I am usign to get a progressive numeber i column D is:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng1 As Range
Dim Rng2 As Range
Dim rCell As Range
Dim iVal As Long

Set Rng1 = Range("A26:A150") ' Columns("A:A")
Set Rng2 = Intersect(Rng1, Target)

If Not Rng2 Is Nothing Then
iVal = Application.Max(Rng1.Offset(0, 3))
On Error GoTo XIT
Application.EnableEvents = False
For Each rCell In Rng2.Cells
With rCell
iVal = iVal + 1
If Not IsEmpty(.Value) Then
With .Offset(0, 3)
If IsEmpty(.Value) Then
.Value = iVal
.NumberFormat = "000"
End If
End With
End If
End With
Next rCell
End If
XIT:
Application.EnableEvents = True
End Sub

 

[Claus Busch]

Hi John,

Am Sat, 12 Jan 2013 20:39:11 +0100 schrieb John:

Il 05/01/2013 17:30, isabelle ha scritto:

the vba code is Ok; however, If I have a number on column G, ie 79560,
after the execution of the code I have 79561, 79562 and so on. It should
be always the same 79560.
I try to change Type:xlFillDefaul to Type:xlFillCopy but the progressive
number in column D is not anymore update and remain exactly as the
previous row.

try Isabelle's code in three steps:

With SH
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
..Range(.Cells(LastRow, 1), .Cells(LastRow, 3)).AutoFill _
Destination:=.Range(.Cells(LastRow, 1), .Cells(LastRow + 1, 3)), _
Type:=xlFillCopy
..Range(.Cells(LastRow, 4), .Cells(LastRow, 4)).AutoFill _
Destination:=.Range(.Cells(LastRow, 4), .Cells(LastRow + 1, 4)), _
Type:=xlFillSeries
..Range(.Cells(LastRow, 5), .Cells(LastRow, 10)).AutoFill _
Destination:=.Range(.Cells(LastRow, 5), .Cells(LastRow + 1, 10)), _
Type:=xlFillCopy
End With


Regards
Claus Busch

 

[John]

It works fine.
Thanks for your help Sir.
Regards
John

 

[isabelle]

hi John,

Public Sub Tester2()
Dim WB As Workbook
Dim SH As Worksheet
Dim LastRow As Long

Set WB = ActiveWorkbook
Set SH = WB.Sheets("UK")

With SH
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
..Range(.Cells(LastRow, 1), .Cells(LastRow, 6)).AutoFill
Destination:=.Range(.Cells(LastRow, 1), .Cells(LastRow + 1, 6)),
Type:=xlFillDefault
..Range(.Cells(LastRow, 8), .Cells(LastRow, 10)).AutoFill
Destination:=.Range(.Cells(LastRow, 8), .Cells(LastRow + 1, 10)),
Type:=xlFillDefault
..Range(.Cells(LastRow, 7), .Cells(LastRow, 7)).Copy
..Range(.Cells(LastRow, 1), .Cells(LastRow + 1, 7))

End With
End Sub

isabelle


Le 2013-01-12 14:39, John a écrit :

 

[isabelle]

correction

Public Sub Tester2()
Dim WB As Workbook
Dim SH As Worksheet
Dim LastRow As Long

Set WB = ActiveWorkbook
Set SH = WB.Sheets("UK")

With SH
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
..Range(.Cells(LastRow, 1), .Cells(LastRow, 6)).AutoFill
Destination:=.Range(.Cells(LastRow, 1), .Cells(LastRow + 1, 6)),
Type:=xlFillDefault
..Range(.Cells(LastRow, 8), .Cells(LastRow, 10)).AutoFill
Destination:=.Range(.Cells(LastRow, 8), .Cells(LastRow + 1, 10)),
Type:=xlFillDefault
..Cells(LastRow, 7).Copy .Cells(LastRow + 1, 7)

End With
End Sub

isabelle

 

[John]

Thanks again for your help Isabelle
It is perfect!
Regards
John