开发者

Copy and Paste using array in VBA

开发者 https://www.devze.com 2023-03-16 01:16 出处:网络
I am trying to create a relatively simple copy and paste procedure. I have certain cell addresses stored in an array (Results1()) and I am trying to extrapolate the row which it is in to copy an entir

I am trying to create a relatively simple copy and paste procedure. I have certain cell addresses stored in an array (Results1()) and I am trying to extrapolate the row which it is in to copy an entire row of data into another Excel sheet. I have the following so far and currently I am getting an object required error when I try to define what my 'NextRow' is. Any advice or feedback would be greatly appreciated!

For i1 = LBound(Results1) To UBound(Results1)
    Set NextRow = Worksheets("searchresult").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                Range(Results(i1)).EntireRow.Copy NextRow
Next i1

Editted code

    For i1 = LBound(Results1) To UBound(Results1)
        Worksheets("properties").Select
        Set p1results = Range(Results1(i1))
        p1results.EntireRow.Copy
            With Worksheets("SearchResult").Select
                NextRow = Range("D65536").End(xlUp).Row + 1
                Cells(NextRow, 1).Select
                ActiveSheet.Paste
            End With
    Next i1

Update: In actuality my data ranges only range from columns D:P so when I count rows I count from column D (4) because columns A-C are empty ranges. Would this affect the way it is pasting my data?

开发者_Python百科
       On Error Resume Next
   For i1 = LBound(Results1) To UBound(Results1)
        Set NextRow = shSearchResult.Cells(shSearchResult.Rows.Count, 4).End(xlUp).Offset(1, 0)
        shProperties.Range(Results1(i1)).EntireRow.Copy NextRow
        If Err.Number <> 0 Then
            Err.Clear
            MsgBox "Bad address" & Results1(i1)
        End If
    Next i1


A few potential causes here:

Your for loop references Results1 but your copy references Results (typo in question? or route cause?)

In your Set NextRow = line references .Cells(Rows.Count, unqualified, Rows refers to the active sheet not "searchresult" sheet. Probably not what you intended, but also will meke no difference in this case.

Likewise Range(Results(i1)) refers to the active sheet, may be ok - depends on the wider context of your application

I suspect that your imediate problem is that NextRow has not been DIM'd. Try adding

Dim NextRow as Range to your Sub

In general it is good practice to use Option Explicit (first line in your module). This forces explicit declaration of all variable.

EDIT

based on your edit a "Method 'Range' of object '_Global' failed" error may be caused by an invalid adress string

Your first code was actually better than your second. Here's a refactor version

Sub zxx()
    Dim Results1(0 To 1) As Variant
    Dim i1 As Long
    Dim NextRow As Range
    Dim shProperties As Worksheet
    Dim shSearchResults As Worksheet


    '  other code ...

    Set shSearchResults = ActiveWorkbook.Worksheets("searchresult")
    Set shProperties = ActiveWorkbook.Worksheets("properties")

    On Error Resume Next
    For i1 = LBound(Results1) To UBound(Results1)
        Set NextRow = shSearchResults.Cells(shSearchResults.Rows.Count, 1).End(xlUp).Offset(1, 0)
        shProperties.Range(Results1(i1)).EntireRow.Copy NextRow
    Next i1


End Sub

To detect bad addresses try adding On Error Resume Next before the For and

        If Err.Number <> 0 Then
            Err.Clear
            MsgBox "Bad Address " & Results1(i1)
        End If

after the copy (inside the for loop)

EDIT2

Copying an EntireRow into a single cell only works if the single cell is in column A because because the EntireRow range overhangs the right hand side of the sheet.

Use this to offset back to column A

Set NextRow = _
    shSearchResults.Cells(shSearchResults.Rows.Count, 4).End(xlUp).Offset(1, -3)


You never use the With Statement, so just do this instead:

For i1 = LBound(Results1) To UBound(Results1)
    Worksheets("properties").Select
    Set p1results = Range(Results1(i1))
    p1results.EntireRow.Copy
    Worksheets("SearchResult").Select
    NextRow = Range("D65536").End(xlUp).Row + 1
    Cells(NextRow, 1).Select
    ActiveSheet.Paste           
Next i1

or better:

For i1 = LBound(Results1) To UBound(Results1)
    Worksheets("properties").Range(Results1(i1)).EntireRow.Copy
    Worksheets("SearchResult").Cells(Range("D65536").End(xlUp).Row + 1, 1).Paste
Next i1

Depending on what you're doing, you might want to use PasteSpecial instead.

0

精彩评论

暂无评论...
验证码 换一张
取 消

关注公众号