简体   繁体   中英

VBA adding data to last row in Excel 2010

I'm newbie to VBA. I'm trying to find some data in Sheet1 and copy it to Sheet2. When I select the data from Sheet1, I need to append it to that already in Sheet2.

I can find and paste the data using the following code, but I can't append it. What have I done wrong in my code?

Sub Copy_To_Another_Sheet_1()

Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim i As Long
Dim NewSh As Worksheet
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

MyArr = Array("37", "283", "300", "112", "1100", "336", "98")

Set NewSh = Sheets("Sheet2")

With Sheets("Sheet1").Range("B5:B500")

    Rcount = 0

    For i = LBound(MyArr) To UBound(MyArr)

        Set Rng = .Find(What:=MyArr(i), _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

        If Not Rng Is Nothing Then
            FirstAddress = Rng.Address
            Do
                Rcount = Rcount + 1
                Rng.EntireRow.Copy NewSh.Range("A" & Rcount)

                Set Rng = .FindNext(Rng)
            Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
        End If
    Next i

End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

I guess that 'append' means to add data when you run the macro again and again. It this situation next time you run will overwrite what you have in sheet2. You need to change Rcount variable into:

Rcount = NewSh.Cells(NewSh.Rows.Count,1).End(xlUp).Row+1

to find first empty cell in Sheet2 in column A. Some additional changes will be required if you run the code for the first time (if you really need to have the results in row 1). Check also where to place Rcount increment line- rather should be moved after .copy line

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM