根据列标题复制粘贴 [英] Copy paste based on column header

问题描述

下面的代码对我来说非常有用，除了它在列中获得空行时会停止。

The following piece of code works great for me except that it stops when it gets an empty row in the column.

我想通过确定复制粘贴直到 A 列的最后一行来对其进行修改。我做了一个 LASTROW 变量，但我不知道要在哪里使用它。

I would like to modify it by determining to copy-paste until the last row in column A. I have made a LASTROW variable, but I can not figure out where to use it exactly.

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

谢谢！

推荐答案

您尝试过这种方法吗？

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

这篇关于根据列标题复制粘贴的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！