CODEWITHSUNDEEP
excelvba
Siraj
Siraj

Reputation: 195

Copy data from one worksheet to another based on column heading including empty cells

I am naïve to macros. I used below code to copy data based on column heading from sheet1 to sheet2 in same workbook. But, it stops copying when an cell is empty. Some cells in the column are empty. So, I need macro to copy entire column data including empty cells as is.

Also, I need same kind of macro to copy between two different workbooks. I appreciate if anyone can provide macro for this.

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

Thanks

Upvotes: 0

Views: 3358

Answers (1)

user6432984
user6432984

Reputation:

Update: Copy column to another workbook with matching column headers.

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

Upvotes: 1

Related Questions