Looking for a mod to Copy and paste data based on Header name

混江龙づ霸主 提交于 2019-12-12 03:07:17

问题


I found Alex P's code to copy and paste column data from one sheet to another based on header values. I also found the way to offset the paste to the start cell and row.

Now I need a bit more refinement. The pasted data pastes where I want but I need to past values only as the routine pastes all and destroys all formatting. I would also like to use this to copy and paste values from an open a second open workbook but that can be accomplished later. Here is the code I am using. From this post: Copy data from one worksheet to another based on column.

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

Any help would be appreciated.


回答1:


You could use xlPasteValues

From this:

Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("ws2").Cells(2, GetHeaderColumn(header.Value))

To this:

Range(header.Offset(1, 0), header.End(xlDown)).Copy
Worksheets("ws2").Cells(2, GetHeaderColumn(header.Value)).PasteSpecial xlPasteValues


来源:https://stackoverflow.com/questions/28649402/looking-for-a-mod-to-copy-and-paste-data-based-on-header-name

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