Macro - Copying undefined number of rows in one column

**Rogy** · 01-16-2015, 04:55 AM

Hi guys,

I would like some help with VBA/macro code. I need to copy undefined number of rows in one column to another worksheet.
In attachment there is an example how it should work, provided that the macro has to copy text on to another worksheet and number od rows is not known.

Copy ALL.xlsm

Thanks!

**alansidman** · 01-16-2015, 05:05 AM

Your explanation is not clear and your example in your spreadsheet has no explanation. What do you mean by an undefined number of rows in one column. Please clarify. Explain your situation explicitly to me as if we were standing in line at grocery store waiting to check out.

**Rogy** · 01-16-2015, 05:19 AM

Sorry for the bad explanation. When I said undefined number of rows, I thought it could be two rows data or fifty or hundred.
The data from the rows should be copied in one column on another worksheet.

Example:

A1 -> C1
B1 -> C2
C1 -> C3
A2 -> C4
B2 -> C5
C2 -> C6
A3 -> C7
B3 -> C8
C3 -> C9
...

better?

EDIT: EXAMPLE

SHEET1
DATA1 DATA2 DATA3
DATA4 DATA5 DATA6
DATA7 DATA8 DATA9
...

SHEET2
DATA1
DATA2
DATA3
DATA4
DATA5
DATA6
DATA7
DATA8
DATA9
...

**alansidman** · 01-16-2015, 05:38 AM

Try this:

Option Explicit

Sub transpose()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    Dim lr1 As Long, lr2 As Long
    lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
    Dim i As Long
    
    Application.ScreenUpdating = False
    With sh1
    For i = 1 To lr1
    lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
        .Range("A" & i & ":C" & i).Copy
        sh2.Range("A" & lr2 + 1).PasteSpecial xlPasteAll, , , True
    Next i
    End With
        
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"
    
End Sub

How to install your new code

Copy the Excel VBA code
Select the workbook in which you want to store the Excel VBA code
Press Alt+F11 to open the Visual Basic Editor
Choose Insert > Module
Edit > Paste the macro into the module that appeared
Close the VBEditor
Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)

To run the Excel VBA code:

Press Alt-F8 to open the macro list
Select a macro in the list
Click the Run button

**Rogy** · 01-16-2015, 06:06 AM

Originally Posted by alansidman

Try this:

Option Explicit

Sub transpose()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    Dim lr1 As Long, lr2 As Long
    lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
    Dim i As Long
    
    Application.ScreenUpdating = False
    With sh1
    For i = 1 To lr1
    lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
        .Range("A" & i & ":C" & i).Copy
        sh2.Range("A" & lr2 + 1).PasteSpecial xlPasteAll, , , True
    Next i
    End With
        
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"
    
End Sub

How to install your new code

Copy the Excel VBA code
Select the workbook in which you want to store the Excel VBA code
Press Alt+F11 to open the Visual Basic Editor
Choose Insert > Module
Edit > Paste the macro into the module that appeared
Close the VBEditor
Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)

To run the Excel VBA code:

Press Alt-F8 to open the macro list
Select a macro in the list
Click the Run button

alansidman, thank you!!! this work great! this will help me a lot!
but if you could help me with two more things.
first, that the copying is done on sheet2 in column C not A, and not skipping the first row.
second, not to skip empty cells
EXAMPLE:

SHEET1
DATA1 DATA2 DATA3
DATA4 DATA5 DATA6
DATA7 DATA8 DATA9

DATA13 DATA14 DATA15
...

SHEET2
DATA1
DATA2
DATA3
DATA4
DATA5
DATA6
DATA7
DATA8
DATA9

DATA13
DATA14
DATA15
...

i hope i explained well, for me its very difficult to explain in English.

**Doc.AElstein** · 01-16-2015, 07:07 AM

Originally Posted by Rogy

alansidman, thank you!!! this work great! this will help me a lot!
but if you could help me with two more things.
first, that the copying is done on sheet2 in column C not A, and not skipping the first row.
second, not to skip empty cells........

Hi Rodgy,
. Alan S already had you "Sort ed" as I was in the middle writing this....

.....so I finished it anyway as an alternative...

.. it is the typical "Array capture" type alternative method to Alan S#s "Spreadsheet" type method (Which i actually prefer as it is easier as a beginner to follow). But theoretically mine is faster for lots of data (I think?) - (It captures all data in one go, does all sorting in VBA as it were, then outputs end results in one go)

... here it is (and I modified it for your new requirements. ). (Try to get your requirements right first time as it is not always easy to modify and sometime means re- writing everything again (I was lucky here, and the modifications were easy)

Here then the code:

Sub ArrayCaptureMehthod_Spose()
    Dim wks1 As Worksheet: Set wks1 = ThisWorkbook.Worksheets("Sheet1") 'Give abbreviations all methods and properties..
    Dim wks2 As Worksheet: Set wks2 = ThisWorkbook.Worksheets("Sheet2") '.. of worrkshhets onbjrct
    Dim irws As Long, iclms As Long, orws As Long: Let orws = 0 'variable counts for use in looping as Array indicies and Bound variable count in loops
        'Dim InArray() As Variant: Let InArray() = wks1.Range("A1").CurrentRegion.Value 'Effectively "Captures the current region )Note perohery of range must be empty, or that will also be captured!! >>  http://www.excelforum.com/excel-new-users-basics/1058406-range-dimensioning-range-and-value-referencing-and-referring-to-arrays.html
    Dim InArray() As Variant: Let InArray() = wks1.UsedRange.Value 'Used range will capture evarything on sheet1 SO DO NOT have anything else on sheet or it will be captured.
    Dim OutArray() As Variant: ReDim OutArray(1 To (UBound(InArray, 1) * UBound(InArray, 2)), 1 To 1) 'Outpu Array can now be given dimensions of maximum size required, that is ( RowsMaximum * ColumnsMaximum ) of Input "Capture" Array
    
    For irws = 1 To UBound(InArray, 1) Step 1 ' go along each row in Input Array, (equivalent to each row in sheet 1.. and
        For iclms = 1 To UBound(InArray, 2) Step 1 '... for each row go through each column in Array, ((equivalent to each cloumn in sheet 1)
                'If InArray(irws, iclms) <> "" Then ' If data is there in next cell in Range, that is to say in captured Array of that Range cell values
            Let orws = orws + 1 'Go to next row in Array (next free place in Array)
            Let OutArray(orws, 1) = InArray(irws, iclms)
                'Else 'Do nothing if empty cells
                'End If
        Next iclms
    Next irws
    
    wks2.Range("C1").Resize(UBound(OutArray, 1), 1) = OutArray 'Neast way to paste output in one go - resize C1 in second sheet to dimension of Output Array and make it equal to outpit Array
    
End Sub 'ArrayCaptureMehthod_Spose()

……. And just in case you want empty cells to be ignored, a second version

Sub ArrayCaptureMehthod_Spose2()
    Dim wks1 As Worksheet: Set wks1 = ThisWorkbook.Worksheets("Sheet1") 'Give abbreviations all methods and properties..
    Dim wks2 As Worksheet: Set wks2 = ThisWorkbook.Worksheets("Sheet2") '.. of worrkshhets onbjrct
    Dim irws As Long, iclms As Long, orws As Long: Let orws = 0 'variable counts for use in looping as Array indicies and Bound variable count in loops
        'Dim InArray() As Variant: Let InArray() = wks1.Range("A1").CurrentRegion.Value 'Effectively "Captures the current region )Note perohery of range must be empty, or that will also be captured!! >>  http://www.excelforum.com/excel-new-users-basics/1058406-range-dimensioning-range-and-value-referencing-and-referring-to-arrays.html
    Dim InArray() As Variant: Let InArray() = wks1.UsedRange.Value 'Used range will capture evarything on sheet1 SO DO NOT have anything else on sheet or it will be captured.
    Dim OutArray() As Variant: ReDim OutArray(1 To (UBound(InArray, 1) * UBound(InArray, 2)), 1 To 1) 'Outpu Array can now be given dimensions of maximum size required, that is ( RowsMaximum * ColumnsMaximum ) of Input "Capture" Array
    
    For irws = 1 To UBound(InArray, 1) Step 1 ' go along each row in Input Array, (equivalent to each row in sheet 1.. and
        For iclms = 1 To UBound(InArray, 2) Step 1 '... for each row go through each column in Array, ((equivalent to each cloumn in sheet 1)
            If InArray(irws, iclms) <> "" Then ' If data is there in next cell in Range, that is to say in captured Array of that Range cell values
            Let orws = orws + 1 'Go to next row in Array (next free place in Array)
            Let OutArray(orws, 1) = InArray(irws, iclms)
            Else 'Do nothing if empty cells
            End If
        Next iclms
    Next irws
    
    wks2.Range("C1").Resize(UBound(OutArray, 1), 1) = OutArray 'Neast way to paste output in one go - resize C1 in second sheet to dimension of Output Array and make it equal to outpit Array
    
End Sub 'ArrayCaptureMehthod_Spose2()

…

Hope that helps.
Alan E

P.s. (By the way, I expect a formula could do this for you.. unfortunately I am not very good with those..)

**Rogy** · 01-16-2015, 07:56 AM

Originally Posted by Doc.AElstein

Hi Rodgy,
. Alan S already had you "Sort ed" as I was in the middle writing this....

.....so I finished it anyway as an alternative...

.. it is the typical "Array capture" type alternative method to Alan S#s "Spreadsheet" type method (Which i actually prefer as it is easier as a beginner to follow). But theoretically mine is faster for lots of data (I think?) - (It captures all data in one go, does all sorting in VBA as it were, then outputs end results in one go)

... here it is (and I modified it for your new requirements. ). (Try to get your requirements right first time as it is not always easy to modify and sometime means re- writing everything again (I was lucky here, and the modifications were easy)

Here then the code:

Sub ArrayCaptureMehthod_Spose()
    Dim wks1 As Worksheet: Set wks1 = ThisWorkbook.Worksheets("Sheet1") 'Give abbreviations all methods and properties..
    Dim wks2 As Worksheet: Set wks2 = ThisWorkbook.Worksheets("Sheet2") '.. of worrkshhets onbjrct
    Dim irws As Long, iclms As Long, orws As Long: Let orws = 0 'variable counts for use in looping as Array indicies and Bound variable count in loops
        'Dim InArray() As Variant: Let InArray() = wks1.Range("A1").CurrentRegion.Value 'Effectively "Captures the current region )Note perohery of range must be empty, or that will also be captured!! >>  http://www.excelforum.com/excel-new-users-basics/1058406-range-dimensioning-range-and-value-referencing-and-referring-to-arrays.html
    Dim InArray() As Variant: Let InArray() = wks1.UsedRange.Value 'Used range will capture evarything on sheet1 SO DO NOT have anything else on sheet or it will be captured.
    Dim OutArray() As Variant: ReDim OutArray(1 To (UBound(InArray, 1) * UBound(InArray, 2)), 1 To 1) 'Outpu Array can now be given dimensions of maximum size required, that is ( RowsMaximum * ColumnsMaximum ) of Input "Capture" Array
    
    For irws = 1 To UBound(InArray, 1) Step 1 ' go along each row in Input Array, (equivalent to each row in sheet 1.. and
        For iclms = 1 To UBound(InArray, 2) Step 1 '... for each row go through each column in Array, ((equivalent to each cloumn in sheet 1)
                'If InArray(irws, iclms) <> "" Then ' If data is there in next cell in Range, that is to say in captured Array of that Range cell values
            Let orws = orws + 1 'Go to next row in Array (next free place in Array)
            Let OutArray(orws, 1) = InArray(irws, iclms)
                'Else 'Do nothing if empty cells
                'End If
        Next iclms
    Next irws
    
    wks2.Range("C1").Resize(UBound(OutArray, 1), 1) = OutArray 'Neast way to paste output in one go - resize C1 in second sheet to dimension of Output Array and make it equal to outpit Array
    
End Sub 'ArrayCaptureMehthod_Spose()

……. And just in case you want empty cells to be ignored, a second version

Sub ArrayCaptureMehthod_Spose2()
    Dim wks1 As Worksheet: Set wks1 = ThisWorkbook.Worksheets("Sheet1") 'Give abbreviations all methods and properties..
    Dim wks2 As Worksheet: Set wks2 = ThisWorkbook.Worksheets("Sheet2") '.. of worrkshhets onbjrct
    Dim irws As Long, iclms As Long, orws As Long: Let orws = 0 'variable counts for use in looping as Array indicies and Bound variable count in loops
        'Dim InArray() As Variant: Let InArray() = wks1.Range("A1").CurrentRegion.Value 'Effectively "Captures the current region )Note perohery of range must be empty, or that will also be captured!! >>  http://www.excelforum.com/excel-new-users-basics/1058406-range-dimensioning-range-and-value-referencing-and-referring-to-arrays.html
    Dim InArray() As Variant: Let InArray() = wks1.UsedRange.Value 'Used range will capture evarything on sheet1 SO DO NOT have anything else on sheet or it will be captured.
    Dim OutArray() As Variant: ReDim OutArray(1 To (UBound(InArray, 1) * UBound(InArray, 2)), 1 To 1) 'Outpu Array can now be given dimensions of maximum size required, that is ( RowsMaximum * ColumnsMaximum ) of Input "Capture" Array
    
    For irws = 1 To UBound(InArray, 1) Step 1 ' go along each row in Input Array, (equivalent to each row in sheet 1.. and
        For iclms = 1 To UBound(InArray, 2) Step 1 '... for each row go through each column in Array, ((equivalent to each cloumn in sheet 1)
            If InArray(irws, iclms) <> "" Then ' If data is there in next cell in Range, that is to say in captured Array of that Range cell values
            Let orws = orws + 1 'Go to next row in Array (next free place in Array)
            Let OutArray(orws, 1) = InArray(irws, iclms)
            Else 'Do nothing if empty cells
            End If
        Next iclms
    Next irws
    
    wks2.Range("C1").Resize(UBound(OutArray, 1), 1) = OutArray 'Neast way to paste output in one go - resize C1 in second sheet to dimension of Output Array and make it equal to outpit Array
    
End Sub 'ArrayCaptureMehthod_Spose2()

…

Hope that helps.
Alan E

P.s. (By the way, I expect a formula could do this for you.. unfortunately I am not very good with those..)

Alan E, it helps a lot! This work like a charm

Thank you very much, and Alan S too. I admit that I was wrong in my explanations and requirements, I'll be better next time, more precise.
And comments in code are very helpful. Thank you for the time you set aside and your knowledge.

**Doc.AElstein** · 01-16-2015, 08:09 AM

Originally Posted by Rogy

Alan E, it helps a lot! This work like a charm

Thank you very much, and Alan S too. .........
And comments in code are very helpful. Thank you for the time you set aside and your knowledge.

. Hi Rogy,
You are Welcome. Glad we all could help.

. Alan

P.s. 1 Welcome to the board !!!

P.s. 2 Edit out some of the stuff in the quotes you give when you reply...(See how my Quotes from you look like)... - Do not include the entire quote unless you really need to, as it makes the Thread unecessary long and difficult to read easilly

P.s. 3 Glad you liked the comments! . I love them......Most people find them annoying!!

**JOHN H. DAVIS** · 01-16-2015, 07:27 AM

Maybe:

Sub Rogy()
Dim rcell As Range
For Each rcell In ActiveSheet.UsedRange
If rcell.Value = "" Then
Sheets("Sheet2").Range("C" & Rows.Count).End(3)(2).Value = " "
Else
rcell.Copy Sheets("Sheet2").Range("C" & Rows.Count).End(3)(2)
End If
Next rcell
End Sub

**Rogy** · 01-16-2015, 07:58 AM

Originally Posted by JOHN H. DAVIS

Maybe:

Sub Rogy()
Dim rcell As Range
For Each rcell In ActiveSheet.UsedRange
If rcell.Value = "" Then
Sheets("Sheet2").Range("C" & Rows.Count).End(3)(2).Value = " "
Else
rcell.Copy Sheets("Sheet2").Range("C" & Rows.Count).End(3)(2)
End If
Next rcell
End Sub

This works also, thank you John H!
I have to notice that this code is a lot shorter.

**Doc.AElstein** · 01-16-2015, 08:02 AM

Originally Posted by JOHN H. DAVIS

Maybe:

..............
Sheets("Sheet2").Range("C" & Rows.Count).End(3)(2).Value = " "
Else
rcell.Copy Sheets("Sheet2").Range("C" & Rows.Count).End(3)(2).........

Hi JOHN H. DAVIS,
. The great things about these Forums is
. 1) seeing the ever increasing different ways of doing the same thing.. I find that the best way to learn
. 2) learning “new” stuff…

… I spent some time looking at detail at the .End property.. I never came up with your version…. And a quick google just now did not find it either….

… but a quick bit of experimenting sees that it is .End(The column number) (The increment in the last cell found by the .End Property).
A great new idea for me – going to the next range as it were with ( ) (2) rather than as usual going to the next row

Thanks

Alan Elston

**JOHN H. DAVIS** · 01-16-2015, 08:09 AM

Alan:

I love to learn new things in the Forums as well, but just to clarify the 3 in .End(3) does not represent the column number, but a shorter version of .End(xlUp).

**Doc.AElstein** · 01-16-2015, 08:15 AM

Originally Posted by JOHN H. DAVIS

........ just to clarify the 3 in .End(3) does not represent the column number, but a shorter version of .End(xlUp).

...thanks I probably would of noticed that.... the next time when I used it and it went wrong!!!!!!
. so thanks for saving me a bit of headache
Alan

Macro - Copying undefined number of rows in one column

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Re: Macro - Copying undefined number of rows in one column

Thread Information

Users Browsing this Thread

Similar Threads

Assigning a macro to ALL cells in a column in table with undefined number of rows

[SOLVED] Deleting a range with defined column widths but undefined numbers of rows.

Macro for copying & inserting a variable number of rows into a separate workbook

Deleting rows in undefined column length

Copying a variable number of rows in a macro

Bookmarks

Bookmarks

Posting Permissions