2016-07-16 4 views
0

私はマクロに慣れていません。私は同じブックでsheet1からsheet2への列の見出しに基づいてデータをコピーするために以下のコードを使用しました。しかし、セルが空のときにコピーが停止します。列の一部のセルは空です。したがって、空のセルを含む列データ全体をそのままコピーするにはマクロが必要です。空のセルを含む列見出しに基づいて、あるワークシートから別のワークシートにデータをコピーします。

また、2つの異なるブック間で同じ種類のマクロをコピーする必要があります。もし誰かがこれをマクロに提供できるのであれば、私は感謝しています。

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 

おかげ

答えて

1

更新:列ヘッダーが一致する別のブックにコピー列。

Sub CopyHeaders() 

    Dim ws2 As Worksheet 
    Dim header As Range, headers As Range 
    Set headers = Worksheets("ws1").Range("A1:Z1") 
    Dim headerColumn As Long 

    Set ws2 = Workbooks("Some Other Workbook").Worksheets("ws2") 

    For Each header In headers 
     headerColumn = GetHeaderColumn(ws2, header.Value) 
     If headerColumn > 0 Then 
      header.Offset(1, 0).EntireColumn.Copy Destination:=ws2.Cells(1, headerColumn) 
     End If 
    Next 
End Sub 

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

優れた、それは同じワークブック – Siraj

+0

になりました正常に動作します。しかし、私は驚くばかりの二つの異なるワークブック – Siraj

+0

の間で動作するように同じことを必要とする、私は私が助けることがうれしいです。 –

関連する問題