Copy paste based on column header

谁说我不能喝 提交于 2019-12-06 15:53:05

问题


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

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

Thank you in advance !


回答1:


Have you tryed this way?

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


来源:https://stackoverflow.com/questions/31741441/copy-paste-based-on-column-header

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!