I currently have a workbook for each person in my team where they have a worksheet named "Panel" that contains their initiatives and progress.
I want to develop a unified spreadsheet containing all their initiatives to have a view of the whole area.
In each "Panel" sheet, the "U5" cell contains the name of the owner. In my consolidated file, I want to put the name of the owner as the name of the corresponding sheet.
I made this macro to get, from a separate folder where they will all put their individual sheets, all the "Panel" sheets, put them in the main file and rename them to identify the owner.
Later on, I'll develop a database with the initiatives, identifying the start and end of the data fields to compile them in a single manner for a dashboard.
This is my code:
Sub GetSheets()
Path = "C:\Users\Admin\Desktop\PMO\Test consolidation\Independent files"
Filename = Dir(Path & "*.xlsm")
Dim wsname As String
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
Worksheets("Panel").Activate
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Worksheets("Panel").Select
wsname = Range("U5")
Worksheets("Panel").Name = wsname
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
Can you help to identify why this is not working?
Thanks!
Here is an example which checks whether path has \ present, whether sheets exists (code a la Rory) and also whether U5 is empty. Assumes, U5 in workbooks you are opening are being used for renaming.
Option Explicit
Sub GetSheets()
Dim path As String
Dim Filename As String
Dim wbMaster As Workbook
Dim wbActive As Workbook
Dim wsPanel As Worksheet
Set wbMaster = ThisWorkbook
path = "C:\Users\Admin\Desktop\PMO\Test consolidation\Independent files"
If Right$(path, 1) <> "\" Then path = path & "\"
Filename = Dir(path & "*.xlsm")
Dim wsname As String
Do While Filename <> ""
Set wbActive = Workbooks.Open(Filename:=path & Filename, ReadOnly:=True)
With wbActive
If Evaluate("ISREF('" & "Panel" & "'!A1)") Then 'Rory 'https://stackoverflow.com/questions/6688131/test-or-check-if-sheet-exists
Set wsPanel = wbActive.Worksheets("Panel")
wsPanel.Copy After:=wbMaster.Worksheets(1)
If Not IsEmpty(wsPanel.Range("U5")) Then
ActiveSheet.Name = wsPanel.Range("U5")
Else
MsgBox "Missing value to rename worksheet in " & Filename
End If
End If
End With
wbActive.Close
Filename = Dir()
Loop
End Sub
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 have 200 folders all with different names in a folder. Now, each folder with a different name has a macro excel file (.xlsm). I'm trying to edit all the files at once with a separate file. The code goes like this:
Sub Button1_Click()
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim strPath As String
Dim strFile As String
'Get the directories
strPath = "C:\Users\generaluser\Desktop\testing main folder\"
strFile = Dir(strPath)
'Loop through the dirs
Do While strFile <> ""
'Open the workbook.
strFileName = Dir(strPath & strFile & "*.xlsm")
'Open the workbook.
Set wb = Workbooks.Open(Filename:=strPath & strFile & "\" & strFileName , ReadOnly:=False)
'Loop through the sheets.
Set ws = Application.Worksheets(1)
'Do whatever
ws.Range("A1").Interior.ColorIndex = 0
'Close the workbook
wb.Close SaveChanges:=True
'Move to the next dir.
strFile = Dir
Loop
End Sub
But this doesn't work. I have tried tweaking it but whatever i do either does nothing or causes an error. Can someone please help me get this code to work.
(also: "testing main folder" is the folder on my desktop which holds the 200 other folders which hold the .xlsm files.)
Put Option Explicit at the top of the module. You'll get some compiler errors, one of them being that strFileName isn't declared. This would have been a great clue as to where to look, because the problem is that you're using two variable names that have roughly the same meaning when you read them, and they're getting mixed up.
After you're done fixing the variables, take a look at the documentation for the Dir function. The second issue is that you're also calling Dir multiple times in the loop, which means that you're skipping results.
It should look something more like this:
Dim wb As Workbook
Dim ws As Excel.Worksheet
Dim file As String
'path never changes, so make it a Const
Const path = "C:\Users\generaluser\Desktop\testing main folder\"
'This returns the first result.
file = Dir$(path & "*.xlsm")
Do While file <> vbNullString
Set wb = Workbooks.Open(Filename:=path & file, ReadOnly:=False)
Set ws = Application.Worksheets(1)
'Do whatever
wb.Close SaveChanges:=True
'This returns the next result, or vbNullString if none.
file = Dir$
Loop
I am new to VBA and am writing a macro. The purpose is to iterate through a list of spreadsheets (I have two sets saved in the same directory and each set has a specific naming convention). One set is named as "GenLU_xx" and the other is named as "LUZ_Summary_xx". The 'xx' in each name refers to a name e.g. Calgary. So I would have two different spreadsheets for Calgary (LUZ_Summary_Calgary & GenLU_Calgary).
The Macro needs to open each spreadsheet starting with "LUZ" add a value to G1. I have accomplished this first part by modifying code I found here: http://www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given-folder
The macro asks the user to identify the directory the spreadsheets are stored in and then loops through ones starting with "LUZ*".
The code is:
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "LUZ*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(fileName:=myPath & myFile)
'Add GEN_LU_ZN to column G1
wb.Worksheets(1).Range("G1").Value = "GEN_LU_ZN"
'Save and Close Workbook
wb.Close SaveChanges:=True
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
What I need for it to do from this point is copy two specific columns from each of the spreadsheets starting with "GenLU" and paste them into sheet 2 of the corresponding spreadsheet.
For example column C & E need to be copied from "GenLU_Calgary_2008" to the second sheet in the corresponding spreadsheet "LUZ_Summary_Calgary_2015". The code needs to somehow match up the spreadsheets using the name (in this case Calgary) and it needs to do this for all the spreadsheets.
Sorry for the extremely long question, but I'm hoping some can help a VBA newb out. I've searched quite a bit and while I have found the code to copy from sheet to sheet or workbook to workbook I am having trouble achieving what I need to. Any help will be much appreciated!
It is hard to test something without having any files, but you can try the following as part of your code:
Dim i As Integer
Dim wb1 As Workbook, wb2 As Workbook
Dim MyAr() As String: MyAr = Split("Calgary,XXX,YYY", ",")
For i = LBound(MyAr) To UBound(MyAr)
Do While myFile <> ""
If myFile Like "GenLU" & "*" & MyAr(i) Then
Set wb1 = Workbooks.Open(Filename:=myPath & myFile)
Exit Do
End If
Loop
Do While myFile <> ""
If myFile Like "LUZ_Summary" & "*" & MyAr(i) And Not wb1 Is Nothing Then
Set wb2 = Workbooks.Open(Filename:=myPath & myFile)
wb2.Worksheets(1).Columns(3).Value = wb1.Worksheets(1).Columns(3).Value
wb2.Worksheets(1).Columns(5).Value = wb1.Worksheets(1).Columns(5).Value
wb1.Close
wb2.Save
wb2.Close
Exit Do
End If
Loop
Set wb1 = Nothing
Next i
Note that you did not provide information which Worksheet you are working on, so I assume its always Worksheets(1). Column C = Columns(3). MyAr() is a String array to store the countries.
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.