CODEWITHSUNDEEP
excelvba
Mark harris
Mark harris

Reputation: 543

copy range and paste on next available row / but change value of first row in column b?

I am using the following macro to copy a range and paste it onto the next available row. 

Dim NextRow As Range
Sub Save8()
Dim sht As Worksheet, currentRow As Range
Application.ScreenUpdating = False
Set sht = Sheets("Time Allocation")
Set currentRow = sht.Range(sht.UsedRange.Address)
Set NextRow = currentRow.Offset(currentRow.Rows.Count, 0)

Sheets("Time Allocation").Range("B506:L515").Copy
'NextRow.PasteSpecial Paste:=1, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
NextRow.PasteSpecial xlPasteAll
Application.CutCopyMode = False
Set NextRow = Nothing
Set currentRow = Nothing
Set sht = Nothing
Application.ScreenUpdating = True
End Sub

The code works fine however say my range i want to copy looks like this:

Example 1       Test
Test            Test
Test            Test
Test            Test

My code will then paste the copied range below the original like so:

Example 1           Test
    Test            Test
    Test            Test
    Test            Test
Example 1           Test
    Test            Test
    Test            Test
    Test            Test

But now I want to increment the value in the top left cell which is in column b 'Example 1'

So each time the range is copied and pasted I will end up with something like:

Example 1           Test
    Test            Test
    Test            Test
    Test            Test
Example 2           Test
    Test            Test
    Test            Test
    Test            Test
Example 3           Test
    Test            Test
    Test            Test
    Test            Test

Please can someone show me how to do this? Thanks in advance

Upvotes: 0

Views: 99

Answers (1)

user4039065
user4039065

Reputation:

The destination of a paste or paste special only has to be the top left cell. If you use that to locate the destination then that same location in column B can be used to insert a formula.

Sub Save8()
    Dim nr As Long

    Application.ScreenUpdating = False

    With Sheets("Time Allocation")
        nr = .Cells(Rows.Count, 2).End(xlUp).Row + 1
        .Range("B506:L515").Copy _
          Destination:=.Cells(nr, 2)
        .Cells(nr, 2).Formula = "=TEXT(COUNTIF(B$1:INDEX(B:B, ROW()-1), ""example*"")+1, ""\Ex\a\mpl\e 0"")"
        'uncomment the next line if you want to remove the formula
        '.Cells(nr, 2) = .Cells(nr, 2).Value2
    End With

    Application.ScreenUpdating = True
End Sub

The formula can be reverted to its returned value by uncommenting the line above.

Upvotes: 0

Related Questions