VBA数组功能可复制列

问题描述

我只是想寻求一些帮助，因为我对使用数组函数不是很熟悉。

基本上，我的源数据具有从列A到列H的数据范围。

此公式将列A复制到我的目的地。但是我还需要将数据从“源D”列复制到“目标”列中，然后从H列复制到“目标”列。

如何将其修改为需要的内容？ 如何在“源”选项卡上过滤和删除空白行？

Dim Source As Worksheet,Destination As Worksheet
Set Source = ThisWorkbook.Worksheets("CAN Daily Hours Summary")
Set Destination = ThisWorkbook.Worksheets("Adjustment_Data")
    
Dim arr As Variant
arr = Source.Range("A1").CurrentRegion

Dim i As Long
For i = LBound(arr,1) + 1 To UBound(arr,1)
    arr(i,1) = arr(i,1)
Next i

Destination.Range("A1").CurrentRegion.Offset(1).ClearContents

Dim rowcount As Long,colummcount As Long
rowcount = UBound(arr,1)

Destination.Range("A2").Resize(rowcount).Value = arr

谢谢您的帮助。

解决方法

传输数据（仅一个阵列）

代码

Option Explicit

Sub transferData()
    
    Const FirstCell As String = "A1"
    Const destOffs As Long = 1
    Const FirstCol As Long = 2
    Const Offs As Long = 2
    
    With ThisWorkbook
        Dim Source As Worksheet
        Set Source = .Worksheets("CAN Daily Hours Summary")
        Dim Destination As Worksheet
        Set Destination = .Worksheets("Adjustment_Data")
    End With
    
    Dim arr As Variant
    arr = Source.Range(FirstCell).CurrentRegion
    
    Dim RowsCount As Long
    RowsCount = UBound(arr,1)
    Dim ColsCount As Long
    ColsCount = UBound(arr,2)
    Dim NumOfCols As Long
    NumOfCols = ColsCount - Offs
    
    Dim i As Long
    Dim j As Long
    For i = 1 To RowsCount
        For j = FirstCol To NumOfCols
            arr(i,j) = arr(i,j + Offs)
        Next j
    Next i
    
    With Destination.Range(FirstCell).CurrentRegion.Offset(destOffs)
        .ClearContents
        .Resize(RowsCount,NumOfCols).Value = arr
    End With
    
End Sub