We help IT Professionals succeed at work.

Column data to row data for an import

Tom Moholland
Tom Moholland used Ask the Experts™
In my example I have several rows of data in column format I need to take the data from the "data sheet tab"and some how get it to populate the sheet labeled upload data.  In the format like the sheet I called needs to look like .
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Mechanical Engineer
Most Valuable Expert 2013
Top Expert 2013
Assuming that the header labels match, here is a macro that will move your columns of data over.
Sub DataMover()
Dim celDest As Range, celSource As Range, Dest As Range, DestHeaders As Range, Source As Range, SourceHeaders As Range
Dim j As Long, nRows As Long

Application.ScreenUpdating = False

With Worksheets("upload sheet")
    Set DestHeaders = .Range("A1")  'First header label on destination sheet
    Set DestHeaders = Range(DestHeaders, .Cells(DestHeaders.Row, .Columns.Count).End(xlToLeft))
    Set Dest = .UsedRange
    Set Dest = Dest.Cells(Dest.Rows.Count + 1, 1)
End With
With Worksheets("Data sheet")
    Set SourceHeaders = .Range("A1")  'First header label on source sheet
    Set SourceHeaders = Range(SourceHeaders, .Cells(SourceHeaders.Row, .Columns.Count).End(xlToLeft))
    Set Source = Intersect(SourceHeaders.EntireColumn, .UsedRange)
    Set Source = Source.Offset(1, 0).Resize(Source.Rows.Count - 1, Source.Columns.Count)
    nRows = Source.Rows.Count
End With

On Error Resume Next
For Each celSource In SourceHeaders
    j = j + 1
    Set celDest = Nothing
    Set celDest = DestHeaders.Find(celSource.Value, LookAt:=xlWhole, MatchCase:=False)
    If Not celDest Is Nothing Then
        Dest.Cells(1, celDest.Column).PasteSpecial xlPasteValuesAndNumberFormats
    End If
On Error GoTo 0
End Sub

Open in new window