VBA snippet required

[Mr.Karr]

Hello,

I have 2 sheets. Data & Allign.
Sheets("Data") is where I have Datadump. Can someone please provide a code snippet to find/search for the particular string from Datadump and paste on Sheets("Allign") without changing or altering the row. That means if "SystemID" found in Row2, it should paste on Sheets("Allign"), row2 against the correct header.

Please see the attached sample file.

Regards,
Kar

 

[Luke M]

In your example book the data sheet didn't have a header row, but destination did, so transfering data to exact same row would over-write the headers. I went ahead and instead shifted the data by one, but if your real workbook has headers in both, it's a simple change.

Sub GatherData()
    Dim rngHeader As Range
    Dim c As Range
    Dim fCell As Range
    Dim firstAdd As String
    Dim wsDest As Worksheet
    Dim wsSource As Worksheet
   
    'What two sheets are we dealing with?
    Set wsDest = Worksheets("Allign")
    Set wsSource = Worksheets("Data")
   
    'Which cells are our headers?
    Set rngHeader = wsDest.Range("A1:D1")
   
    Application.ScreenUpdating = False
   
    For Each c In rngHeader.Cells
        'Look for each header
        With wsSource
            Set fCell = .Cells.Find(what:=c.Value, lookat:=xlPart, MatchCase:=False)
           
            'Make sure we found at least one cell
            If Not fCell Is Nothing Then
                'Store info for later
                firstAdd = fCell.Address
               
                Do
                    'Transfer data to same row + 1, matching column
                    wsDest.Cells(fCell.Row + 1, c.Column).Value = Mid(fCell, Len(c.Value) + 1)
                   
                    'Find next cell
                    Set fCell = .Cells.FindNext(fCell)
                Loop While fCell.Address <> firstAdd
            End If
        End With
    Next c
   
    Application.ScreenUpdating = True
                   
End Sub

 

[Mr.Karr]

Kudos! This is exactly what I need. Thank you @Luke M