identify the last used cell and paste below

Question

I'm a total novice with VBA. I have the following code which does a matching exercise and then pastes the relevant values into col. B. my issue is each time the code is used the col will change how can I add this to the module so that it looks for the last cell used in row 1 and pastes the values below.

Sub TransferData()

Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String

Application.ScreenUpdating = False

lastrow1 = Sheets("Input Sheet").Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow1
    myname = Sheets("Input Sheet").Cells(i, "B").Value
    Sheets("Data").Activate
    lastrow2 = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row

    For j = 2 To lastrow2
        If Sheets("Data").Cells(j, "A").Value = myname Then
            Sheets("Input Sheet").Activate
            Sheets("Input Sheet").Cells(i, "c").Copy
            Sheets("Data").Activate
            Sheets("Data").Cells(j, "B").Select
            ActiveSheet.PasteSpecial
        End If
    Next j
    Application.CutCopyMode = False
Next i
Application.ScreenUpdating = True

End Sub

any assistance with this would be appreciated.

Possible duplicate of [Find out the last used column in a given row - Excel VBA](http://stackoverflow.com/questions/16882143/find-out-the-last-used-column-in-a-given-row-excel-vba). This question does not have the answered accepted, but the answer is correct. There's also probably many more answers on SO about this if you search a bit. — Scott Holtzman, Mar 01 '17 at 17:09

score 0 · Answer 1 · answered Mar 01 '17 at 18:51

0

You can replace your second For j = 2 To lastrow2 with the Match function.

Also, there is no need to Activate the sheets back and fourth all the time, just use fully qualified Ranges instead.

Code

Option Explicit

Sub TransferData()

Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String
Dim MatchRng    As Range

Application.ScreenUpdating = False
j = 2
With Sheets("Input Sheet")
    lastrow1 = .Range("B" & .Rows.Count).End(xlUp).Row

    ' the 2 lines bellow should be outisde the loop
    lastrow2 = Sheets("Data").Range("A" & Sheets("Data").Rows.Count).End(xlUp).Row
    Set MatchRng = Sheets("Data").Range("A2:A" & lastrow2)
    For i = 2 To lastrow1
        myname = .Range("B" & i).Value

        If Not IsError(Application.Match(myname, MatchRng, 0)) Then '<-- if successful Match
            Sheets("Data").Range("B" & j).Value = .Range("C" & i).Value
            j = j + 1
        End If
        Application.CutCopyMode = False
    Next i
End With
Application.ScreenUpdating = True

End Sub

answered Mar 01 '17 at 18:51

Shai Rado

33,032
6
29
51

@Mark have you tried my code in the answer above ? any feedback ? – Shai Rado Mar 03 '17 at 14:18
Shai, just looked at this. it works as expected but my problem is that each time the workbook is used a new date is added to row 1 on the Data sheet and this is where the new data needs to be pasted as it is the above code will only paste to ColB I need someway for the code to identify the correct location to paste. – Mark Mar 07 '17 at 13:51
@Mark this was not in your post above – Shai Rado Mar 07 '17 at 13:53
I thought that's what I asked in the last part of my question, "my issue is each time the code is used the col will change how can I add this to the module so that it looks for the last cell used in row 1 and pastes the values below." – Mark Mar 07 '17 at 15:35

identify the last used cell and paste below

1 Answers1