I am trying to copy multiple sheets to new workbook. I need copy 3 sheets from different workbooks to new create workbook in one sheet.
this is my code:
Private Sub CommandButton1_Click()
Path = "C:\Users\vnohavcova\Desktop\New folder\DB earnie report\"
fileName = Dir(Path & "*.xls")
Do While fileName <> ""
Workbooks.Open fileName:=Path & fileName, ReadOnly:=True
For Each sheet In ActiveWorkbook.Sheets
sheet.Copy After:=DestWkb.Sheets(1)
Next sheet
Workbooks(fileName).Close
fileName = Dir()
Loop
Related
I'm trying to save a folder of excel sheets as .csv. However, I only able to save the .csv of the active sheet. Would it be possible to specify which sheet within these folder of excel files that I would like to extra it from?
Thank you so much !
Where should I put the sheetname in my code to specify that the looping should only occur for that particular sheet? Thank you!
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
nameWb = myPath & Left(myFile, InStr(1, myFile, ".") - 1) & ".csv"
ActiveWorkbook.SaveAs Filename:=nameWb, FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
'Get next file name
myFile = Dir
Loop
I'm doing roughly the same in my project. I copy the WS I want to save to a new WB, and then save the new file.
Workbooks(ExportFile).Worksheets(ExportSheet).Copy
ActiveWorkbook.SaveAs "path/" & ExportSheet & ".txt", FileFormat:=xlCSV
As far as I know, making copies of the worksheets is the only way of saving specific worksheets.
Here's how to loop through the sheets. You basically probably are going to test if the name matches your pre-determined list. You could also use error checking for named ranges, or a wide variety of other ways to flag which sheets to use.
'define variables
Dim wb As Workbook, WS As Worksheet
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Here's the loop you are looking for I think
For Each WS In wb.Worksheets
'OR statements/If statements can be used.
'Also lookout for name syntax being case-sensative. You might
'want to include Ucase on both sides to defend against inconsistencies.
If WS.Name = "LetsDoThisSheet!" Or UCase(WS.Name) = UCase("AndThisone2") Then
WS.Visible = xlSheetVisible
WS.Activate
nameWb = myPath & Left(myFile, InStr(1, myFile, ".") - 1) & ".csv"
ActiveWorkbook.SaveAs Filename:=nameWb, FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
End If
Next WS
'Get next file name
myFile = Dir
Loop
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 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!
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 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