Question

Sorry, I feel like this is probably super basic, but I am trying to use Excel and VBA to move data from multiple cells per row into an empty column in a specific order. Some of the cells might not have data so I have to check that as well and skip empty ones with something along the lines of Value <> Empty.

Basically, what I am trying to do is take a table that looks like this (with empty column A):

B1 C1 D1 E1
B2 C2 D2 [E2empty]
B3 C3 D3 E3

And set it up like this in column A:

B1
C1
D1
E1
B2
C2
D2
B3
C3
D3
E3

It would be entered in one row at a time into the new column.

I guess I am trying to figure out how to say the following in code

In Row 1, check if cell B is empty. If not, move Value to column A, first avaible cell, 
next cell in row 1, (repeat).
Next Row( do the same as row 1.)

So I was thinking of using For i = 1 To rwcnt where rwcnt is defined by CountA(Range("B:B")) To do the rows in order and then doing a similar thing inside that for-statement for cells (Maybe j = B To E?).

So my overall goal is to scan my range (MyRange = ActiveSheet.Range("B1:E" & rwcnt)) and move everything into column A in the order described at the top, but I don't know how to move data to column A in sequence. Any advice on how to accomplish this would be very helpful.

Answer 1

Loop through all the used rows, looping columns starting at B in that row. Check if the cell is not empty. Write it to A next cell.

In you VBA IDE go to the tools menu and selecte references. Select "Microsoft scripting runtime"

Dim lRow As Long
Dim lRowWrite as long
Dim lCol As Long
Dim ws As Excel.Worksheet
Dim ts As TextStream
Dim fs As FileSystemObject

'Create the text file to write to
Set fs = New FileSystemObject
Set ts = fs.CreateTextFile("C:\Temp\test.txt", True, False)

Application.ScreenUpdating = False
Set ws = Application.ActiveSheet
lRowWrite = 1
lRow = 1

'Loop through all the rows.
Do While lRow <=ws.UsedRange.Rows.count
    'Loop through all the columns
    lCol = 2
    Do While lCol <=ws.UsedRange.Columns.count
        'Check if it is empty
        If not isempty(ws.Cells(lRow, lCol)) Then
            'Not empty so write it to the text file
            ts.WriteLine ws.Cells(lRow, lCol)
        End If
        lCol = lCol + 1
    Loop

    lRow = lRow + 1
    ws.Range("A" & lRow).Activate
Loop

Application.ScreenUpdating = True

ts.Close: Set ts = Nothing
Set fs = Nothing

Answer 2

Try this:

Sub test()
Dim lastCol As Long, lastRow As Long, k As Long, i As Long, colALastRow As Long
Dim rng           As Range
Dim ws            As Worksheet

'Columns(1).Clear   ' uncomment this if you want VB to force Col. A to be cleared
Application.ScreenUpdating = False
Set ws = ActiveSheet
lastCol = ws.UsedRange.Columns.Count    'This will get the last column
lastRow = ws.UsedRange.Rows.Count    'this will get the last used row

k = 2                        'Set k to 2, to start in Col B
colALastRow = 1              'This starts at 1, since your entire Column A is empty

With ws
    For i = 1 To lastRow
        lastCol = .Cells(i, 2).End(xlToRight).Column
        Set rng = .Range(.Cells(i, 2), .Cells(i, lastCol))
        ' rng.Select
        rng.Copy
        .Range(.Cells(colALastRow, 1), .Cells(colALastRow + (lastCol), 1)).PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True
        Application.CutCopyMode = False
        colALastRow = .Cells(1, 1).End(xlDown).Row + 1

    Next i
End With
Application.ScreenUpdating = True
MsgBox ("Done!")
End Sub

Edit: Changed the lastCol, lastRow, etc. from Integer to Long, since there will be over 32,767 rows.

Edit 2: I commented out rng.Select. This is because there's no reason to select it for the Macro. I only had it there, because as I worked through the macro (using F8), I wanted to make sure it was grabbing the right ranges. It is, so you can comment this out. It might even make it run slightly faster :)

Excel Moving Data From Rows Into a Column

2 个答案: