Sub GetSheetnames()
 'Turn off alerts
      Application.DisplayAlerts = False

  'Open the Workbook that i want to look for the worksheet names this
  'white book template is a save as copy of another file as it makes it
  'easier to reference as I work with 1000's of file with same format but
   'are all saved as a different name

  Workbooks.Open Filename:="D:ProjectsASE TemplatesASE Template White
  Book.xlsx"
  Dim ws As Worksheet
  Dim i As Integer
  With ThisWorkbook.Worksheets("Tab Names from white book")
  .Range("A:A").ClearContents
  For Each ws In ActiveWorkbook.Worksheets
  i = i + 1
 .Range("A" & i) = ws.Name

 Next ws

End With

 Workbooks("ASE Template White Book.xlsx").Close

  Application.DisplayAlerts = True

 End Sub

With ThisWorkbook.Worksheets("Tab Names from white book")
   .Range("A:A").ClearContents
   For Each ws In ActiveWorkbook.Worksheets
   i = i + 1
  .Range("A" & i) = ws.Name

 Next ws

With ThisWorkbook.Worksheets("Tab Names from white book")
      .Range("B:B").ClearContents
      For Each ws In ActiveWorkbook.Worksheets
      i = i + 1
     .Range("B" & i) = H4.value

.Range("B" & i) = Cells(3,8).Value