CODEWITHSUNDEEP
vbaexcel
JAGR
JAGR

Reputation: 1

Excel Macro: Arranging Data from a row to different column

I have an Excel file that has only one column. I want to move the content from first 4 rows into four different columns (first row in column 1, second row in column 2, etc.) and then I want to repeat this same operation until all the values from the columns has been distributed to these four columns(the four rows repeat in a series). Then, each row has a unique word that I want to find and based on this I want to move it (cut and paste) to a specific column. I think the example below it is easier to explain. I want to find the word 'cheese' and if found I want it to be moved to column two and this operation repeated until all the rows containing the word 'cheese' have been arranged into a single column. I'm trying to arrange the data into a table that I can further use later. Thanks for the help. I get the data from a .txt file and putting it into Excel is proving to be a bit difficult too.

Example

Row1
Cheese: 250
Row2
Ham: 35
Row3
Cheese: 200
Row 4
Ham:40
Row5
Cheese: 230
Row6
Ham:45

Code

Sub test4()

    Dim lastrow As Long
    lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

    For i = 1 To lastrow
        Range("A1").Activate
        Cells.Find(What:="Part").Copy
        If ActiveSheet.Cells(i, 2) = "" Then
            ActiveSheet.Cells(i, 2).Activate
            'Range("B1").Activate
            ActiveCell.PasteSpecial (xlPasteAll)
        End If
    Next i
End Sub

Upvotes: 0

Views: 97

Answers (2)

user6432984
user6432984

Reputation:

enter image description here

Sub MoveData()
    Dim x As Long
    Application.ScreenUpdating = False

    For x = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Range("B1:E1").Cells(x).Value = Cells(x, 1).Value
    Next

    Columns(1).Delete
    Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

Upvotes: 2

Tim Williams
Tim Williams

Reputation: 166206

This will copy data starting at C1 

Sub test4()
    Const PER_ROW As Long = 4
    Dim i As Long, sht as WorkSheet

    Set sht = ActiveSheet

    For i = 1 To sht.UsedRange.SpecialCells(xlCellTypeLastCell).Row

        sht.Cells(1,3).offset(Application.Floor((i-1)/PER_ROW, 1) , _
                              (i-1) Mod PER_ROW).value = sht.Cells(i,1).Value
    Next i

End Sub

Upvotes: 2

Related Questions