I want to print all the sheet names in a particular excel sheet. If I was doing it for the current workbook, this is how my code would be:
For Each sht In ActiveWorkbook.Sheets
Debug.Print sht.Name
Next sht
I want to print the names of all the sheets present in a variable, say sFilePath which is the absolute file path of an excel file. How do I print the names of all the sheets in that excel file?
You need to open that file before you get sheets names:
Dim sFilePath As String
sFilePath = Application.GetOpenFilename()
Workbooks.Open (sFilePath)
For Each sht In ActiveWorkbook.Sheets
Debug.Print sht.Name
Next sht
'to close sFilePath workbook
ActiveWorkbook.Close False
Hope this help.
to print file and sheets in a given directory:
Sub Main()
filePath = "C:\Users\jesse\Documents\ExcelTest\" 'folder to search
currentFile = Dir(filePath & "*.xls*")
Do Until currentFile = ""
Debug.Print currentFile
Set Workbook = Workbooks.Open(filePath & currentFile, False, True)
For Each Sheet In Workbook.Sheets
Debug.Print Sheet.Name
Next Sheet
Workbook.Close SaveChanges:=False
currentFile = Dir
Loop
Set Workbook = Nothing
End Sub
Hope this solved your problem. cheers!
Related
I have multiple workbooks which all have the tab named "example". I am wanting to adjust my current file to check if the current sheet is named "example", add the name of the workbook in front of "example" e.g. "File1 example" and move this tab into another file.
Currently i have the below, which pulls all tabs from all workbooks into a new workbook.
Sub GetSheets()
Path = "C:\TestPath\"
Filename = Dir(Path & "*.xls")
MsgBox (Filename)
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
Instead of looping through all sheets of a workbook you can just access it directly if you already know its name.
Also make sure not to exceed the max length that is allowed for a worksheet name. This is 31 characters so trim the workbook name or you might run into errors.
Public Sub GetSheets()
Dim Path As String
Path = "C:\TestPath\"
Dim Filename As String
Filename = Dir(Path & "*.xls")
Dim ws As Worksheet
MsgBox (Filename)
Dim OpenWb As Workbook
Do While Filename <> ""
Set OpenWb = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
OpenWb.Worksheets("example").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'copy after last sheet
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Left$(OpenWb.Name, 31) 'don't exceed max allowed length
OpenWb.Close False 'we do not save changes in the opened Workbook
Filename = Dir()
Loop
End Sub
Note an error handling might be needed if there is a possibility that any of the files has no worksheet named example.
Something like this should work for you.
Sub GetSheets()
Path = "C:\TestPath\"
Filename = Dir(Path & "*.xls")
Dim ws As Worksheet
MsgBox (Filename)
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each ws In ActiveWorkbook.Sheets
If ws.Name = "example" Then 'name of tab
ws.Name = ws.Name & " " & ActiveWorkbook.Name
ws.Copy After:=ThisWorkbook.Sheets(1)
Exit For
End If
Next ws
Workbooks(Filename).Close False 'we do not save changes in the opened Workbook
Filename = Dir()
Loop
End sub
I am hoping someone is able to help.
I am looking at merging several workbooks in excel together but each workbook has 8-10 tabs that I don't need and I in fact only want a single tab, I have the following formula already which combines the workbooks, but I am unsure what to do to only combine the single tabs that I need, they are all the same name in each workbook.
Sub GetSheets()
Path = "C:\Users\dt\Desktop\dt kte\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
Thank you
it's one of those cases where I'd use the infamous On Error Resume Next statement consciously and avoid looping through a collection (namely Worksheets one)
furthermore ThisWorkbook always references the workbook the running code resides in so there's no need for any Workbook type variable referring to it
Sub GetSheets()
Path = "C:\Users\dt\Desktop\dt kte\"
Filename = Dir(Path & "*.xls")
On Error Resume Next
Do While Filename <> ""
Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True).Worksheets("SHEETNAME").Copy After:=ThisWorkbook.Sheets(1)
ActiveWorkbook.Close False
Filename = Dir()
Loop
End Sub
just change SHEETNAME to you actual needed tab name
If you only need to copy a specific sheet from each, the following should work (just tweak SHEETNAME to whatever that is)
Sub GetSheets()
dim mainWB as Workbook
Set mainWB = ThisWorkbook
Path = "C:\Users\dt\Desktop\dt kte\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
If sheet.Name = "SHEETNAME" then
Sheet.Copy After:=mainWB.Sheets(1)
End if
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
I'm using a VBA code to cycle through excel files in a directory and pull information from one worksheet and paste into a newly created worksheet. I'm also naming my new worksheets (in my destination file) by the name in one of the cells in the source file.
My code works for the first loop but fails/stops in the second loop (VBA points to an error in the Dest.Sheets.Add(After:=Dest.Sheets(Dest.Sheets.Count)).Name = Sheetname line. I need to loop through 75 of these files and I'm unsure of what's going on because it works correctly for the first file.
Thanks so much for the help!
Sub AddSummaryTables()
Dim Spath, Filename, Sheetname As String
Dim Source, Dest As Workbook
Dim WS As Worksheet
Set Dest = ThisWorkbook
Spath = InputBox("Enter File Source Path") & "\"
Filename = Dir(Spath & "*.xls*")
Do While Filename <> ""
Set Source = Workbooks.Open(Spath & Filename)
Sheetname = Source.Sheets("Summary").Range("B2").Text
MsgBox Sheetname
Dest.Sheets.Add(After:=Dest.Sheets(Dest.Sheets.Count)).Name = Sheetname
Source.Sheets("Summary").Range("A1:R150").Copy
Dest.Worksheets(Sheetname).Range("A1").PasteSpecial xlPasteValues
Dest.Worksheets(Sheetname).Range("A1").PasteSpecial xlPasteFormats
Dest.Worksheets(Sheetname).Range("A1:R150").WrapText = False
Dest.Worksheets(Sheetname).Rows.AutoFit
Dest.Worksheets(Sheetname).Columns.AutoFit
Source.Close SaveChanges:=False
Dest.Save
Filename = Dir()
Loop
End Sub
following Comintern's and Wyatt's suggestion you could try like follows
Option Explicit
Sub AddSummaryTables()
Dim sPath As String, fileName As String
Dim sourceWb As Workbook, destWb As Workbook
Dim sourceWs As Worksheet, destWs As Worksheet
Set destWb = ThisWorkbook
sPath = InputBox("Enter File Source Path") & "\"
fileName = Dir(sPath & "*.xls*")
Do While fileName <> ""
Set sourceWb = Workbooks.Open(sPath & fileName)
Set sourceWs = GetWorksheet(sourceWb, "Summary")
If Not sourceWs Is Nothing Then
Set destWs = SetWorksheet(destWb, sourceWs.Range("B2").Text)
sourceWs.Range("A1:R150").Copy
With destWs
.Range("A1").PasteSpecial xlPasteValues
.Range("A1").PasteSpecial xlPasteFormats
.UsedRange.WrapText = False
.Rows.AutoFit
.Columns.AutoFit
End With
sourceWb.Close SaveChanges:=False
destWb.Save
End If
fileName = Dir()
Loop
End Sub
Function GetWorksheet(wb As Workbook, sheetName As String) As Worksheet
On Error Resume Next
Set GetWorksheet = wb.Worksheets(sheetName)
On Error GoTo 0
End Function
Function SetWorksheet(wb As Workbook, sheetName As String) As Worksheet
Dim i As Integer
Do While Not GetWorksheet(wb, sheetName & IIf(i = 0, "", "-" & i)) Is Nothing
i = i + 1
Loop
With wb
.Worksheets.Add(After:=.Worksheets(.Worksheets.Count)).Name = sheetName & IIf(i = 0, "", "-" & Format(i, "000"))
Set SetWorksheet = .ActiveSheet
End With
End Function
where you make sure that
any opened workbook has a "Summary" worksheet
you name worksheets in your destination workbook such as not to have duplicates: if you happen to deal with say three worksheets named "Sheet5" then your destination workbook will have added worksheets "Sheet5", "Sheet5-001" and "Sheet5-002".
You're issue may be that when you are adding the sheet from the second workbook, it has the same name as the sheet from the first workbook. You could check if the sheet exists and add a number to it. The post below might help.
Test or check if sheet exists
I'm trying to pull one tab into a master workbook from a number of workbooks in a specified folder. so far this is what I have:
Sub GetSheets()
Path = "D:\APQP\APQP\Open Projects\"
Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheets("5-Phase").Select
Sheets("5-Phase").Copy Before:=ThisWorkbook.Sheets(1)
Next
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
Right now when I run it, it populates the master workbook with 50 of the tabs from the first wookbook in the folder instead of coping the tab and moving on to the next workbook and coping the tab in that workbook. Any help would be great.
You have two major problems with your code. The For loop is unnecessary and you aren't working with the opened workbook. Something like this should work for you:
Sub GetSheets()
Dim wb As Workbook
Dim sPath As String
Dim sFileName As String
Set wb = ThisWorkbook
sPath = "D:\APQP\APQP\Open Projects\"
sFileName = Dir(sPath & "*.xlsx")
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
Do While Len(sFileName) > 0
With Workbooks.Open(sPath & sFileName, ReadOnly:=True)
.Sheets("5-Phase").Copy Before:=wb.Sheets(1)
.Close False
End With
sFileName = Dir()
Loop
On Error GoTo 0
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
I'm attempting to apply a macro that would copy and paste one specific worksheet (call the title of that worksheet "x") from one workBOOK ("x1") , onto a master workBOOK (call that workBOOK "xmaster"), after it copy and pastes the worksheet from workbook x1 it should also rename the title of the worksheet "x" to cell B3. This should be done before it moves to the next workbook.
It would need to do this for workBOOK x1 through, say, x100. I cannot refer to the workbook by name though, because they are each named a string of text that is in no real sortable method.
This code I know works, copying "x" from "x1" to "xmaster", along with renaming the sheet, and breaking the links, is the following:
Sub CombineCapExFiles()
Sheets("Capital-Projects over 3K").Move After:=Workbooks("CapEx Master File.xlsm").Sheets _
(3)
ActiveSheet.Name = Range("B3").Value
Application.DisplayAlerts = False
For Each wb In Application.Workbooks
Select Case wb.Name
Case ThisWorkbook.Name, "CapEx Master File.xlsm"
' do nothing
Case Else
wb.Close
End Select
Next wb
Application.DisplayAlerts = True
End Sub
The Activate Previous window isn't working, also not sure how to fix that portion of it.
I'm not sure how to build this to loop through all workBOOKs in the directory, however.
Should I use this:?
MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xlsx", vbNormal) 'change to xlsm if needed ?
If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder
Do Until strFilename = ""
'Your code here
strFilename = Dir()
Loop
An additional constraint is that it needs to not run the macro on xmaster (it will have an error because it will not have the sheet "x" which will be renamed from the previous workbooks.)
Thanks!
Matthew
like this?
(not tested)
Option Explicit
Sub LoopFiles()
Dim strDir As String, strFileName As String
Dim wbCopyBook As Workbook
Dim wbNewBook As Workbook
Dim wbname as String
strDir = "C:\"
strFileName = Dir(strDir & "*.xlsx")
Set wbNewBook = Workbooks.Add 'instead of adding a workbook, set = to the name of your master workbook
wbname = ThisWorkbook.FullName
Do While strFileName <> ""
Set wbCopyBook = Workbooks.Open(strDir & strFileName)
If wbCopyBook.FullName <> wbname Then
wbCopyBook.Sheets(1).Copy Before:=wbNewBook.Sheets(1)
wbCopyBook.Close False
strFileName = Dir()
Else
strFileName = Dir()
End If
Loop
End Sub
This bit will work to avoid running the macro on xmaster.
xmaster = "filename for xmaster"
MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xls*", vbNormal) 'this will get .xls, .xlsx, .xlsm and .xlsb files
If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder
Do Until strFilename = ""
If strFileName = xmaster Then ' skip the xmaster file
strFilename = Dir()
End If
'Your code here
strFilename = Dir()
Loop
I can't help on the other part though. I don't see any Activate Previous window part in your code.