Getting all the worksheets name in another workbook

[Niraj Baraili]

Hi Experts,

I have a workbook containing more that 50 sheets. i need the worksheets in a another workbook. Let say, all the sheets name from 'CUSTOMIZED REPORT.xlsx' need be saved in book1.xlsx. For this i have written a code as below, but somehow it's showing error.

Sub test()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim Wb3 As Workbook
Dim i As Integer
Dim sht_count As Integer
Dim path As String

path = "C:\Users\niraj.baraili\Desktop\Automation\Raw Data\"

ChDir path

Set Wb1 = Workbooks.Open("CUSTOMIZED REPORT.xlsx")
Set Wb2 = Workbooks("book1.xlsx")
Set Wb3 = Workbooks("CUSTOMIZED REPORT.xlsx")

With Wb1
sht_count = Worksheets.Count
End With
For i = 1 To sht_count
  Wb2.Sheet1.Range("A" & i) = Wb3.Sheets(i).Name
Next i

End Sub

I think file as not required for this.
Any help on this is appreciated.

 

[moroccan]

Hi
Try this

Sub Test()
Dim Wb As Workbook
Dim i As Integer
Dim Sht_count As Integer
Dim Path As String

Application.ScreenUpdating = False
Path = "C:\Users\niraj.baraili\Desktop\Automation\Raw Data\"
Set Wb = Workbooks.Open(Path & "CUSTOMIZED REPORT.xlsx")
With Wb
  Sht_count = .Worksheets.Count
  For i = 1 To Sht_count
  ThisWorkbook.Sheet1.Range("A" & i) = .Sheets(i).Name
  Next i
End With
Wb.Close False
End Sub

Or this

Sub Test()
Dim Wb As Workbook
Dim Sh As Worksheet
Dim Path As String

Application.ScreenUpdating = False
Path = "C:\Users\niraj.baraili\Desktop\Automation\Raw Data\"
Set Wb = Workbooks.Open(Path & "CUSTOMIZED REPORT.xlsx")
With Wb
  For Each Sh In .Sheets
  ThisWorkbook.Sheet1.Cells(Rows.Count, 1).End(xlUp)(2) = Sh.Name
  Next Sh
End With
Wb.Close False
End Sub

Dont forget points

 

[jindon]

Try.
This will not open the workbook.

Sub test()
    Dim fn As String, rs As Object, a() As String, n As Long, t As Long
    fn = "C:\Users\niraj.baraili\Desktop\Automation\Raw Data\CUSTOMIZED REPORT.xlsx"
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & fn & ";" _
            & "Extended Properties='Excel 12.0'"
        Set rs = .OpenSchema(20)
        While Not (rs.EOF)
            t = Len(rs("TABLE_NAME")) - IIf(rs("TABLE_NAME") Like "*$'", 2, 1)
            n = n + 1: ReDim Preserve a(1 To n): a(n) = Left$(rs("TABLE_NAME"), t)
            rs.MoveNext
        Wend
        rs.Close
        .Close
    End With
    ThisWorkbook.Sheets(1).Cells(1).Resize(n).Value = Application.Transpose(a)
End Sub

 

[Niraj Baraili]

Hi Moroccan,

Thank you very much.

@jindon -Excellent.

 

[YasserKhalil]

Great Mr. Jindon
Really great code
But as for results the code gets the sheets name from last to first ..
How can I edit the code to get the sheets names from first sheet to last sheet?

 

[jindon]

The result should show alphabetic order, not by index.
This should be better for just sheet names.

Sub test()
    Dim fn As String, rs As Object, a() As String, n As Long, temp As String
    fn = Application.GetOpenFilename("ExcelFiles,*.xls*")
    If fn = "False" Then Exit Sub
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & fn & ";" _
            & "Extended Properties='Excel 12.0'"
        Set rs = .OpenSchema(20, Array(Empty, Empty, Empty, "Table"))
        While Not (rs.EOF)
            temp = rs("TABLE_NAME")
            n = n + 1: ReDim Preserve a(1 To n)
            a(n) = Left$(temp, Len(temp) - IIf(temp Like "*'", 2, 1))
            rs.MoveNext
        Wend
        rs.Close
        .Close
    End With
    Cells(1).Resize(n).Value = Application.Transpose(a)
End Sub

 

[YasserKhalil]

Thanks a lot Mr. Jindon for this great gift
In fact I need the sheets name in the order of index not alphabetically