I am a novice at Visual Basic. I can use either Excel 2010 or Excel 2013 for this task.
I have dozens of workbooks with data on the first worksheet of each. For example One.xlsx, Two.xlsx, Three.xlsx, Four.xlsx each contain information on their respective Sheet1.
I need the information on Sheet1 from each workbook to be combined into a single workbook with sheets that are named from the file name of the original workbook. So for example combined.xlsx would have 4 sheets named One, Two, Three, Four. In every case all information on the underlying worksheets should be copied and combined in the new Workbook as shown below.
The Format I need
I found this Macro / Add-In online that gets me close to what I need using the open files add in choice.
http://www.excelbee.com/merge-excel-sheets-2010-2007-2013#close
The Open Files Add-In successfully allows me to aggregate the various Workbook's worksheets into a single workbook. However the tabs are not named from the name of the original file.
Correct aggregation of sheets, but incorrect worksheet names.
For now all the underlying Workbooks will be in the same folder. The ability to browse and select the files would be nice if this ever changes but if that is too difficult, just indicating the directory path in the Visual Basic code would work. As far as the resultant combined output probably ought to be a new workbook, the filename of the new workbook isn't that important. It could be called combined.xlsx for example.
The following accomplishes the task.
Option Explicit
Private Sub CommandButton1_Click()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim WrdArray() As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "c:\test\"
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
Workbooks.Open (directory & fileName)
WrdArray() = Split(fileName, ".")
For Each sheet In Workbooks(fileName).Worksheets
Workbooks(fileName).ActiveSheet.Name = WrdArray(0)
total = Workbooks("import-sheets.xlsm").Worksheets.Count
Workbooks(fileName).Worksheets(sheet.Name).Copy after:=Workbooks("import-sheets.xlsm").Worksheets(total)
GoTo exitFor:
Next sheet
exitFor:
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
In Excel press Alt+F11, this will open the Excel VBA editor.
Article http://www.excel-spreadsheet.com/vba/debugging.htm explains some basics how to use it.
In Module1 there are 2 short subroutines opensheets and merge containing ~50 lines of code.
Use F1 with cursor within words you don't understand, to learn what it means.
Once you understand what the code does, you can tailor it to your needs.
Related
I have created an Excel Macro at work to be used for assembling consolidated reports in Excel. The macro allows you to select a number of files, it then goes through those files and renames the first tab in each file (which with the way it is used is the only tab) to match the file name (so you can rename the files without having to open all and rename tabs), and then merges all these tabs into your current workbook, creating a large consolidated report.
However, I am running into the problem that the macro defaults to do this to the selected files in the alphabetical order of the file names, which then requires us to sort the tabs after we have run the macro.
What I am looking for is an adjustment to the macro that will sort the files by creation date&time, oldest to newest, because the order the files are created generally matches the desired result in our final reports.
I figure I will need to make a separate for i = 1 to etc loop that re-orders the selected files, store the new order, and use that order for the current loop, but I am not sure how to do that. I did to some searches, but while I found some similar items, anything similar seems to use a folder selection rather than individual file selection, and there were other differences I couldn't quite translate to my macro either. Here is the current macro:
Sub Reports()
Dim numberOfFilesChosen, i As Integer, Workbookname As String, tempFileDialog As FileDialog, mainWorkbook, sourceWorkbook As Workbook
Dim tempWorkSheet As Worksheet
Set mainWorkbook = Application.ActiveWorkbook
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
tempFileDialog.AllowMultiSelect = True
numberOfFilesChosen = tempFileDialog.Show
Application.ScreenUpdating = False
For i = 1 To tempFileDialog.SelectedItems.Count
Workbooks.Open tempFileDialog.SelectedItems(i)
Set sourceWorkbook = ActiveWorkbook
With sourceWorkbook
Workbookname = Left(.Name, InStr(.Name, ".") - 1)
.Sheets(1).Name = Workbookname
End With
For Each tempWorkSheet In sourceWorkbook.Worksheets
tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
Next tempWorkSheet
sourceWorkbook.Close savechanges:=False
Next i
Application.ScreenUpdating = True
End Sub
I hope you can help me, thank you!
I've finally figured out why my code was crashing. I have this set up as part of my Personal Macro Workbook so when I open a default Book1 I can run it. However, the issue is that since it's running the macro from the PMW the "Sheet.Copy After:=ThisWorkbook.Sheets(1)" is crashing.
How can I make it that the code below running from the PMW would copy the sheets into the default Book1?
Original code below;
Sub GetSheets()
Application.AutoRecover.Enabled = False
LInput:
PL = Application.InputBox("Threshold Report Path", "", "C:\Users\")
Path = PL
Filename = Dir(Path & "*.csv")
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
ThisWorkbook refers to the workbook with the macro.
You can refer to it by name:
Sheet.Copy After:=Workbooks("Foo").Sheets(1)
I think you misunderstand the purpose of the Personal Macro Workbook; it shouldn't be auto-running anything. It's not a template. It's a place to store macros that you use often, so that instead of copying the macros to different workbooks, you can leave it in one place an run it from there.
I think what you want is a Personal Template that includes the template worksheet already, so nothing needs to be copied every time you create a new document.
Create a workbook, copy the worksheet in manually, and save it as a template. Avoid auto-run code in the template as well.
See links below for more information.
More information:
What you are trying to use:
Office.com : Create and save all your macros in a single workbook
Office.com : Create and save all your macros in a single workbook
What you should be using:
Office.com : Save a workbook as a template
Makeuseof : How to Quickly Create a Custom Excel Template to Save Time
Private Sub CommandButton1_Click()
Dim ws As Worksheet
With Application.FileDialog(msoFileDialogFilePicker)
.Show
If .SelectedItems.Count <> 0 Then
fldr = .SelectedItems(1)
End If
End With
Sheets.link.Value = fldr
For i = 1 To Worksheets.Count
Set ws = Worksheets(i)
If ws.Cells(2, 1) = "X" Then
Sheets.ComboBox1.AddItem (ws.Name)
End If
Next i
Workbooks.Open (fldr)
Sheets.Show
End Sub
Private Sub Add_Click()
Dim x As String
Dim ws As Workbook
x = Right(link.Value, (Len(link.Value) - InStrRev(link.Value, "ild") - 3))
Workbooks("Test.xlsm").Activate
Worksheets(ComboBox1.Value).Copy Before:=Workbooks(x).Worksheets("Contract")
End Sub
So the basic idea is, you click a button on an Excel sheet. The user then finds the file they want to copy the sheets to. It will find all of a specific type of sheet, put it in a forms combobox and open the selected Excel file.
Then you choose a sheet from the combobox and copy it from one workbook to the other. It all works until the copying part. I get a long error:
Excel cannot insert the sheets into the destination workbook, because it contains fewer rows and columns that the source workbook. To move or copy the data to the destination workbook, you can select the data and then use Copy and Paste commands to insert it into the sheets of another workbook.
If the destination workbook comes from an older version of Excel (extension .xls for instance, Excel 97 or Excel 2003), the limit of number of rows in old worksheets is 2^16-1, as the row number is encoded on 16 bits. In newer versions, this number is encoded on 32 bits.
Hence, copying a worksheet "as a whole" from a newer version into a workbook from an older version raises this error. From my test, this error occurs even if the actually used range in the copied worksheet is small.
I had this same problem.
Following #A.S.G. suggestion, I saved the old workbook with the new file format (xlsx), closed and reopened it and everything worked fine afterwards.
Hope it helps.
I have a folder of .xlsx files, each identical in layout.
I need to write a macro in excel to open each file in turn (100+ files)
then get the data (a name) from a single cell, and drop it in a new excel worksheet, move on to the next and insert that below the last one etc.
Giving me basically a list of names from data not file names)
Here is (pretty much) exactly what you're trying to do. Next time do a little bit of googling before you ask! :)
http://www.excel-easy.com/vba/examples/files-in-a-directory.html
ROUGH CODE UNSURE IF IT WILL WORK: But here is the basic idea of what you need to modify in the example I sent you. If you look at the example again, it does everything you need and then some. Since you weren't interested in all worksheets, you don't have to loop through all worksheets in a workbook. You can just open it up, read your cell of interest, and then close it. The Do While loop will do this for every Excel file in your directory. AGAIN! Please modify this example accordingly before you use it.
Dim directory As String, fileName As String, sheet As Worksheet, i As Integer, j As Integer
Application.ScreenUpdating = False
directory = "c:\test\"
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
i = i + 1
Workbooks.Open (directory & fileName)
Workbooks("files-in-a-directory.xls").Worksheets(1).Cells(i, 1).Value = Workbooks(fileName).Worksheets(1).Cells(x, y) <-- whatever your cell of interest is
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
I need help with a coding requirement that I've not previously experienced. I just browsed a similar issue raised here a couple of years ago - VBA to Copy files using complete path and file names listed in Excel Object.
My issue is similar but somewhat simpler than the OP.
I have a number of folders that each contain about 100 small .csv files; for each folder I need to copy the path for each file to an open worksheet. Each folder of .csv files has its own associated workbook.
As one example, the open workbook is F:\SM\M400AD.xlsm and the active worksheet is CSV_List. The folder containing the .csv files is F:\SM\M400AD.
Doing it manually, my sequence is then:
Open folder F:\SM\M400AD
Select all
Copy path
Paste to Range("B11") of worksheet CSV_List
When I do it manually, as described above, I get a list that looks like:
"F:\SM\M400AD\AC1.csv"
"F:\SM\M400AD\AC2.csv"
"F:\SM\M400AD\AE.csv"
"F:\SM\M400AD\AF.csv"
"F:\SM\M400AD\AG.csv"
"F:\SM\M400AD\AH1.csv"
"F:\SM\M400AD\AH2.csv"
"F:\SM\M400AD\AJ.csv"
and on down the page until I have a list of 100 paths. This single column list is then pasted into worksheet CSV_List, starting at Range("B11").
I need to automate this and would be grateful if a VBA guru could kindly code this for me.
Such of question has been asked before, for example:
Loop through files in a folder using VBA?
List files in folder and subfolder with path to .txt file
The difference is you want to "automate" it, which means you want to execute code on workbook Open event.
How to achieve that?
Open F:\SM\M400AD.xlsm file.
Go to Code pane (ALT+F11)
Insert new module and copy below code
Option Explicit
Sub EnumCsVFilesInCurrentFolder()
Dim sPath As String, sFileName As String
Dim i As Integer
sPath = ThisWorkbook.Path & "\"
i = 11
Do
If Len(sFileName) = 0 Then GoTo SkipNext
If LCase(Right(sFileName, 4)) = ".csv" Then
'replcae 1 with proper sheet name!
ThisWorkbook.Worksheets(1).Range("B" & i) = sPath & sFileName
i = i + 1
End If
SkipNext:
sFileName = Dir(sPath)
Loop While sFileName <> ""
End Sub
Now, go to ThisWorkbook module and insert below procedure:
Private Sub Workbook_Open()
EnumCsVFilesInCurrentFolder
End Sub
Save and close workbook
The workbook is ready to use. Whenever you open it, EnumCsVFilesInCurrentFolder macro will be executed.
Note: you have to change above code to restrict the number of records.