Consolidate column from multiple sheets into single column on another sheet

Question

I need to copy all the text values from Column F on +10 sheets and place them in a single Column on an aggregate sheet. I do not need to perform any computation on the data, just copy the text values derived from formulas. For example:

Sheet1 Col F:

1

2

3

Sheet2 Col F:

4

5

6

I would like "Master" Col A be:

1

2

3

...

6

This code gets me mostly there, but I need the Range to vary. For instance, not every sheet has 3 rows of data, but I want them to be copied directly after each other.

Sub MM1()
Dim ws As Worksheet, lr As Long
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each ws In Worksheets
    If ws.Name <> "Master" Then
        ws.Range("F1:G15").Copy 
        Sheets("Master").Range("A" & lr).PasteSpecial xlPasteValues
        lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End If
Next ws
End Sub

EDIT: Every sheet DOES have the same number of rows with a formula in them, but the Values vary from sheet to sheet. So I need some check that looks for a "" Value as the "last row" then move to the next sheet.

You already have a line of code that calculates the last row, why not alter it to find the bounds of the sheet that you're copying from — Jchang43, Dec 05 '18 at 00:19
I Frankensteined this code together from multiple posts to meet my needs, but have little grasp of VBA. Can you assist with how to find the bounds of the sheet? — Sam Jump, Dec 05 '18 at 00:25
https://stackoverflow.com/a/11169920/10361731 This shows you how to find the last row with a bit more explanation. To find it for a new sheet, just change the sheets qualifier. — Jchang43, Dec 05 '18 at 00:29
I added _lastrow = Sheets(ws,Name).Cells(Rows.Count, "F").End(xlUp).Row + 1_ within the for loop, but have taken steps backwards. Also changed the _ws.Range("F1:G15").Copy_ to _ws.Range("F" & lastrow).Copy_ — Sam Jump, Dec 05 '18 at 01:03

score 1 · Accepted Answer · answered Dec 05 '18 at 04:56

First of all, you can use the same logic to get the last row in the column "F" in each datasheet instead of hard-coding 3 rows usingrange.end(xlUp).Row method.

2nd I don't like the copy-paste method. it is slow and is very bothering you always calculate new insertion point and paste. You can utilize array in VBA to realize this functionality. And work with Array is very straightforward and fast.

Below is the code you can grab and use.

Sub MM1()
Application.ScreenUpdating = False
'Loop through worksheets, put the values in column F into arr array
Dim arr(1 To 10000), cnt As Integer, i As Integer
cnt = 0
For Each ws In Worksheets
    If ws.Name <> "Master" Then
        For i = 1 To ws.Cells(Rows.Count, "F").End(xlUp).Row
            cnt = cnt + 1
            arr(cnt) = ws.Cells(i, "F").Value
        Next i
    End If
Next ws

'Loop through arr array, populate value into Master sheet, column A
For i = 1 To cnt
    ThisWorkbook.Sheets("Master").Cells(i, "A") = arr(i)
Next i

Application.ScreenUpdating = True
End Sub

Thanks for the reply. Please see my edit to my post. Your solution works, but i'd like to not copy the Blank values to the destination. I would like the loop to start on the next ws when a Blank value is present. — Sam Jump, Dec 05 '18 at 16:42
@Sam Jump Use `ws.Cells(Rows.Count, "F").End(xlUp).Row` assume your data is reside in continues range. If you wanna have the logic “Whenever facing a empty value, then jump to new sheet” you can add one more control statement to code `If ws.Cells(i, "F").Value = "" Then exit For` in the inner most loop — Gen.L, Dec 05 '18 at 17:08

score 0 · Answer 2 · answered Dec 05 '18 at 04:22

only small changes and its working good :)
1. I changed the Master to Sheet5 => you can use your sheet name.
2. Added a new variable in loop to identify the range for each sheet to be copied.
3. Change the method to paste the copied data to destination.

Sub MM1()
Dim ws As Worksheet, lr As Long
lr = Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each ws In Worksheets
    If ws.Name <> "Sheet5" Then
        Dim currentRange As Long
        currentRange = ws.Cells(Rows.Count, "A").End(xlUp).Row
        ws.Range("A1:A" & currentRange).Copy Destination:=Sheets("Sheet5").Range("A" & lr)
        lr = Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End If
Next ws
End Sub

let me know if this works for you or not ?

Thanks for the reply. This solution worked but copied the Formulas instead of Values. Additionally, I edited my original post for clarification. — Sam Jump, Dec 05 '18 at 16:44

Raphael Lee · Answer 3 · 2018-12-05T03:58:26.763

I tried to keep your code as intact as possible. Here is one way to make it work (with as much preservation of your code as possible). There are still minor "touch ups" you would need to do (eg your "Master" sheet would have a blank row).

Sub MM1()
Dim ws As Worksheet
For Each ws In Worksheets
     If ws.Name <> "Master" Then
         ws.Range(ws.Range("F1"), ws.Range("F1").End(xlDown)).Copy
         Sheets("Master").Range("A65535").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
     End If
Next ws
End Sub

Consolidate column from multiple sheets into single column on another sheet

3 Answers3