Copying columns of data to second worksheet based on input on third worksheet

[StuartE]

I have a table of data that i want to copy only certain columns from into a second worksheet based on input on a third worksheet.

Data in source data (sheet1) starts in A1 and is of variable column and row numbers
Sheet 2 is destination sheet and data should start to be pasted into A1. All column data should be copied if the column header is included in sheet 3
Sheet 3 contains a variable length list of column headers from sheet 1 required to be included on the report on sheet 2. List starts in cell B2 on this sheet and works down a column

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim v As Variant, hdWS As Worksheet, srcWS As Worksheet, desWS As Worksheet, i As Long, fnd As Range
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    Set hdWS = Sheets("Sheet3")
    v = hdWS.Range("B2", hdWS.Range("B" & Rows.Count).End(xlUp)).Value
    For i = LBound(v) To UBound(v)
        Set fnd = srcWS.Rows(1).Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            With desWS
                srcWS.Cells(1, fnd.Column).EntireColumn.Copy .Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1)
            End With
        End If
    Next i
    desWS.Columns(1).Delete
    Application.ScreenUpdating = True
End Sub

 

[StuartE]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim v As Variant, hdWS As Worksheet, srcWS As Worksheet, desWS As Worksheet, i As Long, fnd As Range
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    Set hdWS = Sheets("Sheet3")
    v = hdWS.Range("B2", hdWS.Range("B" & Rows.Count).End(xlUp)).Value
    For i = LBound(v) To UBound(v)
        Set fnd = srcWS.Rows(1).Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            With desWS
                srcWS.Cells(1, fnd.Column).EntireColumn.Copy .Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1)
            End With
        End If
    Next i
    desWS.Columns(1).Delete
    Application.ScreenUpdating = True
End Sub