Copy name of multiple sheets one below the other

[excelsql987]

https://app.box.com/folder/0


In this example/code I am trying to copy the name of each tab into the summary tab (column A)
please help
thx

 

[AliGW]

Making a list of sheet names:

1. In Names Manager on the Formulas ribbon, create a new name called SheetNames and type this into the reference box at the bottom: =GET.WORKBOOK(1)&T(NOW())
2. In A1 type this and copy down: =IFERROR(INDEX(MID(SheetNames,FIND("]",SheetNames)+1,255),ROWS(A$1:A1)),"")
3. Save as a macro-enabled file.

<cite style="margin:0in;font-family:Calibri;font-size:9.0pt;color:#595959">From <http://www.mrexcel.com/forum/excel-questions/955864-list-sheet-names.html#post4590835> </cite>

 

[excelsql987]

Thanks a lot Ali for the quick help.
I am trying to modify the VBA code to make it more effective and avoid manual adjastments

 

[Joe4]

Cross-posted: copy sheet names in column A in summary sheet

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule #13 here: http://www.mrexcel.com/forum/showthread.php?t=99490).

This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

For a more complete explanation on cross-posting, see here: Excelguru Help Site - A message to forum cross posters).

 

[excelsql987]

This code works perfect for me; however, all I am trying to add is the name of the other worksheets on each row into column R on the Summary tab.

Public Sub CopyandPaste()
    
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim wsDest As Worksheet
  
 
     'What sheet do we paste to?
    Set wsDest = Worksheets("summary")
    Set wsPull = Worksheets("StructureAll")
    Application.ScreenUpdating = False
     Sheets("summary").Range("A2:R6000").ClearContents
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> wsDest.Name And ws.Name <> wsPull.Name Then
            With ws
                lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
                 'Copy col A-Q, starting in row 1
                .Range("A2:Q" & lastRow).Copy
              
                 'Paste values to col A of dest sheet
                wsDest.Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
              
            End With
        End If
    Next ws
     
     'clean-up
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
     
End Sub