[英]Copy paste based on column header
下面的代码对我来说非常有用,除了它在列中出现空行时会停止。
我想通过确定复制粘贴到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
先感谢您 !
您尝试过这种方式吗?
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.