Move data

[sunil352]

Hi

looking for macro script to transpose columns to specific filed
example:
flag 5
start 116
tag 15
owner 5
last 84

flag 3
start 3
owner 3
last 3

flag 4
start 4
tag 4
last 4

my specific fields are flag,start,tag,owner and last and i want related information to be move to there respective filed

LIKE
flag start tag owner last
5 116 15 5 84
3 3 3 3
4 4 4 4

 

[Luke M]

Will all 5 fields be present in each block?
Are there spaces between the blocks (constant or varying in size)?

 

[sunil352]

Will all 5 fields be present in each block?
Are there spaces between the blocks (constant or varying in size)?

total number of fields will be 5 but may varying in size in each block as shown in example tag is missing in 2nd block like wise

 

[sunil352]

example

 

[Luke M]

Copy all of this into a module, and run it. Make adjustments to sheet definitions as needed.

Option Explicit
Option Compare Text

Sub TransferInfo()
Dim sourceWS        As Worksheet
Dim destWS          As Worksheet
Dim lastRow         As Long
Dim recRow          As Long
Dim outCol          As Long
Dim i               As Long
Dim cValue          As String
Dim newData         As Boolean
Dim blankAdded      As Boolean

recRow = 2
newData = False
Application.ScreenUpdating = False

'Define our source sheet
Set sourceWS = Worksheets("Sheet1")
'Defining this as a new sheet, but could define as any sheet if you want
Set destWS = Worksheets.Add

With sourceWS
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With destWS
    'setup headers
    .Range("A1").Value = "flag"
    .Range("B1").Value = "start"
    .Range("C1").Value = "tag"
    .Range("D1").Value = "owner"
    .Range("E1").Value = "last"
   
    For i = 1 To lastRow
        cValue = Trim(sourceWS.Cells(i, "A").Value)
        newData = False
        Select Case cValue
        Case "flag"
            outCol = 1
        Case "start"
            outCol = 2
        Case "tag"
            outCol = 3
        Case "owner"
            outCol = 4
        Case "last"
            outCol = 5
        Case Else
            newData = True
        End Select
       
        'Check if a blank row encountered
        If newData Then
            'Check if we already moved to next line
            If blankAdded = False Then recRow = recRow + 1
            blankAdded = True
        Else
            blankAdded = False
            .Cells(recRow, outCol).Value = sourceWS.Cells(i, "B").Value
        End If
    Next i
End With
Application.ScreenUpdating = True
   
End Sub