根据列 header 复制粘贴

Question

以下代码对我来说非常有用，只是它在列中出现空行时停止。

我想通过确定 copy-paste 直到第 A 列的最后一行来修改它。我做了一个 LASTROW 变量，但我不知道在哪里使用它。

LASTROW = Range("A" & Rows.Count).End(xlUp).Row


Sub CopyHeaders()
Dim header As Range, headers As Range
Set headers = Worksheets("ws1").Range("A1:Z1")

For Each header In headers
    If GetHeaderColumn(header.Value) > 0 Then
        Range(header.Offset(1, 0), header.End(xlDown)).Copy    Destination:=Worksheets("ws2").Cells(2, GetHeaderColumn(header.Value))
    End If
Next
End Sub

Function GetHeaderColumn(header As String) As Integer
Dim headers As Range
Set headers = Worksheets("ws2").Range("A1:Z1")
GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)),  Application.Match(header, headers, 0), 0)
End Function

提前致谢！

Answer 1

你试过这种方法吗？

For Each header In headers
    If GetHeaderColumn(header.Value) > 0 Then
        Range(header.Offset(1, 0).Address, Worksheets("ws1").Cells(Rows.Count, header.Column).End(xlUp).Address).Copy Destination:=Worksheets("ws2").Cells(2, GetHeaderColumn(header.Value))
    End If
Next

根据列 header 复制粘贴

Copy paste based on column header

excel

copy-paste

vba