[英]VBA Array function to copy columns
只是想寻求一些帮助,因为我不太熟悉使用数组 function。
基本上,我的源数据包含从 A 列到 H 列的一系列数据。
此公式将 A 列复制到我的目的地。 但我还需要从源列 D 到 H 的数据复制到我的目的地,从 C 列开始。
我怎样才能将其修改为我需要的?
如何筛选和删除源选项卡上的空白行?
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, columncount 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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.