简体   繁体   中英

Array for multiple columns and paste into different sheet, getting #ref at the last row?

I want to copy put a range of columns into an array and paste columns based into a different worksheet using an array.

I want to put column A2 to H from RESOURCEPLANNING into an array and paste column A,B,D,F & G into Resource_Output worksheet, however I get #REF. error at the bottom of my table.

Currently my code is:

Sub Resourceplanning_array()
    Dim Var As Variant
    Dim my_Arange As Variant
    Dim rp As Worksheet, rp_opt As Worksheet
    
    Set rp = Sheets("RESOURCE_PLANNING")
    Set rp_opt = Sheets("RP_Output")
    
    Dim cell As Range


my_Arange = rp.Range("A2", rp.Range("H" & Rows.Count).End(xlUp))
   Var = Application.Index(my_Arange, Evaluate("row(1:" & [a1].CurrentRegion.Rows.Count & ")"), Array(1, 2, 4, 6, 8))

rp_opt.Range("A1:E" & UBound(Var)) = Var 'Output the Array.
End Sub

Slice a 2D Array

  • It is assumed that the data starts in A1 and has a row of headers.
  • You have to use 7 instead of 8 to copy column G instead of column H .
  • [A1].CurrentRegion.Rows.Count may yield different results depending on which worksheet is active, so you should rather qualify the range: rp.Range("A1").CurrentRegion.Rows.Count .
  • rp.Range("A1").CurrentRegion.Rows.Count may be different than rp.Range("H" & rp.Rows.Count).End(xlUp).Row , so you should opt for one (I've opted for the former).
  • A quick fix could be [a1].CurrentRegion.Rows.Count - 1 , but is not recommended due to the previous two reasons. rp.Range("A1").CurrentRegion.Rows.Count - 1 would be better.
  • Both solutions do the same except for the out-commented 'exclude-headers-parts' in the first solution, which you could use to not include the headers, and the 'clear-contents-part' in the second solution, which you could use to clear the contents below the destination range.
  • Adjust the values in the constants section, the workbook reference, and if headers should be excluded (and if the contents below the destination range should be cleared).
Option Explicit

Sub sliceArray()
    
    Const sName As String = "RESOURCE_PLANNING"
    Const sCols As String = "A:H"
    
    Const dName As String = "RP_Output"
    Const dFirst As String = "A1"
    Dim dCols As Variant: dCols = VBA.Array(1, 2, 4, 6, 8) ' 'VBA': zero-based
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    'Dim wb As Workbook: Set wb = ActiveWorkbook ' workbook you're looking at
    
    ' Source Worksheet
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    
    ' Source/Destination Rows Count
    Dim rCount As Long: rCount = sws.Range("A1").CurrentRegion.Rows.Count
    ' No headers
    'Dim rCount As Long: rCount = sws.Range("A1").CurrentRegion.Rows.Count - 1
    
    ' Source Array
    Dim sData As Variant
    sData = sws.Columns(sCols).Resize(rCount).Value
    ' No headers
    'sData = sws.Columns(sCols).Resize(rCount).Offset(1).Value
    
    ' Destination Array
    Dim dData As Variant
    dData = Application.Index(sData, Evaluate("Row(1:" & rCount & ")"), dCols)
    
    ' Destination Columns Count
    Dim dcCount As Long: dcCount = UBound(dCols) + 1 ' = UBound(dData, 2)
    ' Destination Worksheet
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    ' Destination Range
    Dim drg As Range: Set drg = dws.Range(dFirst).Resize(rCount, dcCount)
    
    ' Write
    drg.Value = dData

End Sub

Sub sliceArrayShort()
    
    Const sName As String = "RESOURCE_PLANNING"
    Const sCols As String = "A:H"
    
    Const dName As String = "RP_Output"
    Const dFirst As String = "A1"
    Dim dCols As Variant: dCols = VBA.Array(1, 2, 4, 6, 8)
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Read
    Dim rCount As Long
    Dim sData As Variant
    With wb.Worksheets(sName)
        rCount = .Range("A1").CurrentRegion.Rows.Count
        sData = .Columns(sCols).Resize(rCount).Value
    End With
    
    ' Slice
    Dim dData As Variant
    dData = Application.Index(sData, Evaluate("Row(1:" & rCount & ")"), dCols)
    
    ' Write (& Clear)
    With wb.Worksheets(dName).Range(dFirst).Resize(, UBound(dCols) + 1)
        .Resize(rCount).Value = dData
        '.Resize(.Worksheet.Rows.Count - .Row - rCount + 1) _
            .Offset(rCount).ClearContents
    End With

End Sub

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