Collecting the first column from 85 sheets

[itsrich]

I have a massive Workbook (85 sheets). I want to get the data in the first column of every sheet onto one sheet in one column.

Is there any easy way to do this, or is it brute force?

 

[jolivanes]

Into an existing sheet or a new sheet?

 

[itsrich]

New sheet. I have to comb the data before I use it.

 

[JEC]

Here some brute force

Sub jec()
 ReDim ary(40000, 0)
 Dim sh, ar, j As Long, x As Long
 For Each sh In Sheets
   ar = sh.UsedRange.Columns(1)
   For j = 1 To UBound(ar)
     If ar(j, 1) <> "" Then
        ary(x, 0) = ar(j, 1)
        x = x + 1
     End If
   Next
 Next
 Sheets.Add(,Sheets(Sheets.Count)).Cells(1).Resize(x) = ary
End Sub

or

Sub jecc()
 Dim sh, ar, j As Long
 With CreateObject("scripting.dictionary")
   For Each sh In Sheets
     ar = sh.UsedRange.Columns(1)
     For j = 1 To UBound(ar)
       If ar(j, 1) <> "" Then .Item(.Count) = Array(ar(j, 1), 0)
     Next
   Next
  Sheets.Add(, Sheets(Sheets.Count)).Cells(1).Resize(.Count) = Application.Index(.items, 0, 0)
 End With
End Sub

 

[itsrich]

The simple answer, I need to teach myself how to program in Excel.

Back in college, I learned Fortran, Pascal, Basic, Cobold, and another one that escapes me now. Recently I learned G-Code to program a plasma cutter.

Now to find the time.

TYVM JEC! I will work on this tomorrow.

 

[JEC]

Good luck! and you're welcome

 

[jolivanes]

I see some people are way faster than I am. Maybe I should have waited having lunch!!!!

Sub One_Way_Maybe()
Dim i As Long, sh1 As Worksheet, dataArr
Sheets.Add(Before:=Sheets(1)).Name = "FirstSheet"
Set sh1 = Sheets("FirstSheet")
    For i = 2 To ThisWorkbook.Worksheets.Count
        With sh1
            dataArr = Sheets(i).UsedRange.Columns(1).Value
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(dataArr)).Value = dataArr
        End With
    Next i
End Sub

 

[itsrich]

I have not used VBA much. I have recorded macros, but not much more. I am using MS365 Enterprise. (Microsoft® Excel® for Microsoft 365 MSO (Version 2405 Build 16.0.17628.20006) 64-bit )

I used the Automate Menu, opened "New Script", Pasted below and clicked run with the script below. Guessing my error. The logs suggest an error on line #4

Sub jecc()
Dim sh, ar, j As Long
With CreateObject("scripting.dictionary")
For Each sh In Sheets
ar = sh.UsedRange.Columns(1)
For j = 1 To UBound(ar)
If ar(j, 1) <> "" Then .Item(.Count) = Array(ar(j, 1), 0)
Next
Next
Sheets.Add(, Sheets(Sheets.Count)).Cells(1).Resize(.Count) = Application.Index(.items, 0, 0)
End With
End Sub

I used the second script you prepared and got this result....

Output (1)Problems (68)Help (4)



• 
  Line #1: ';' expected.
  Sub jecc(
  
  Line #2: ';' expected.
  Dim sh, ar, j As Lon
  
  Line #2: ';' expected.
  Dim sh, ar, j As Lon
  
  Line #2: ';' expected.
  Dim sh, ar, j As Lon
  
  Line #3: ';' expected.
  With CreateObject("scripting.dictionary"
  
  Line #4: ';' expected.
  For Each sh In Sheet
  
  Line #4: ';' expected.
  For Each sh In Sheet
  
  Line #4: ';' expected.
  For Each sh In Sheet
  
  Line #4: ';' expected.
  For Each sh In Sheet
  
  Line #6: ';' expected.
  For j = 1 To UBound(ar
  
  Line #6: ';' expected.
  For j = 1 To UBound(ar
  
  Line #6: ';' expected.
  For j = 1 To UBound(ar
  
  Line #7: ';' expected.
  If ar(j, 1) <> "" Then.Item(.Count) = Array(ar(j, 1), 0
  
  Line #7: Expression expected.
  If ar(j, 1) <> "" Then.Item(.Count) = Array(ar(j, 1), 0
  
  Line #7: ';' expected.
  If ar(j, 1) <> "" Then.Item(.Count) = Array(ar(j, 1), 0
  
  Line #7: Argument expression expected.
  If ar(j, 1) <> "" Then.Item(.Count) = Array(ar(j, 1), 0
  
  Line #10: Argument expression expected.
  Sheets.Add(, Sheets(Sheets.Count)).Cells(1).Resize(.Count) = Application.Index(.items, 0, 0
  
  Line #10: Argument expression expected.
  Sheets.Add(, Sheets(Sheets.Count)).Cells(1).Resize(.Count) = Application.Index(.items, 0, 0
  
  Line #10: Argument expression expected.
  Sheets.Add(, Sheets(Sheets.Count)).Cells(1).Resize(.Count) = Application.Index(.items, 0, 0
  
  Line #11: ';' expected.
  End Wit
  
  Line #12: ';' expected.
  End

Insert action
Made 11 formatting edits between lines 2 and 11

 

[JEC]

This automate tab is for office scripts.
You have to press alt + F11 to open VBA editor. Right click on the project and insert a new module. Then paste the code

Since you are using O365, you can also use a formula like this:

=VSTACK('sheet1:sheet85'!A1:A1000)

Change the sheetnames to suit

 

[itsrich]

WOW!!!! Copy, Paste, Run, and hours saved!! We have JOY!

Sub jec()
 ReDim ary(40000, 0)
 Dim sh, ar, j As Long, x As Long
 For Each sh In Sheets
   ar = sh.UsedRange.Columns(1)
   For j = 1 To UBound(ar)
     If ar(j, 1) <> "" Then
        ary(x, 0) = ar(j, 1)
        x = x + 1
     End If
   Next
 Next
 Sheets.Add(,Sheets(Sheets.Count)).Cells(1).Resize(x) = ary
End Sub

TYVM JEC