I have 500+ spreadsheets that I need to extract 5 rows from each one. They're all saved in the same folder. I just need to be able to create a code that runs through each file in the specified directory, extracts the first 5 rows of each file (only one worksheet per file), and paste the results all in one summarized worksheet.
This is the code I have so far (doesn't work as intended):
Public Sub CommandButton1_Click()
Dim mainBook As Workbook
Set mainBook = ActiveWorkbook
Dim fso As New Scripting.FileSystemObject
Dim fle As Scripting.File
Dim book As Workbook
For Each fle In fso.GetFolder("C:\dir").Files
Set book = Workbooks.Open(fle.Path)
Dim wks As Worksheet
For Each wks In book.Worksheets
wks.Range("A5:A10").Copy mainBook.Worksheets(1) 'copies to the start of the main workbook
Next
book.Close
Next
End Sub
Thank you.
wks.Range("A5:A10").Copy mainBook.Worksheets(1), you need to actually paste to a range, try
wks.Range("A5:A10").Copy mainBook.Worksheets(1).cells(mainBook.Worksheets(1).rows.count,"A").end(xlup).offset(1)
Related
I am trying to copy 4 sheets from 4 different workbooks into the 'Master' workbook that I am in
The below code just does it for one sheet but I want to do it for all 4 sheets
Also, currently the code below opens up the source sheet but I don't want to open source sheets. If I remove '.Open" from below file path then it says subscript out of range
Thanks
Sub Copysheets()
Dim source As Workbook
Dim Master As Workbook
Set source = Workbooks.Open("\\filepath\filename.xlsx")
Set Master = Workbooks.Open("\\filepath\filename.xlsm")
Dim sourcesheet As Worksheet
For Each sourcesheet In source.Sheets
sourcesheet.Copy After:=Master.Sheets(Master.Sheets.Count)
Next
End Sub
If you have a task that you need to do repeated times, usually it's a good idea outsource the task to a subroutine.
The following routine gets 2 parameters, the first is the master (the workbook where you want to copy the sheets into) and a filename (with the name of the file to be opened and copied). This copy-routine doesn't care about your business logic, it simply copies the sheets:
Sub Copysheets(masterWB As Workbook, sourceWBName As String)
Dim sourceWB As Workbook, sourceSheet As Worksheet
Set sourceWB = Workbooks.Open(sourceWBName)
For Each sourceSheet In sourceWB.Sheets
sourceSheet.Copy After:=masterWB.Sheets(masterWB.Sheets.Count)
Next
' Don't forget to close the file afterwards:
sourceWB.Close SaveChanges:=False
End Sub
You could then call the the routine like this (this piece of code handles your business logic but doesn't care about how the copy is done):
Sub CopySheetsFrom4Workbooks()
Dim masterWB As Workbook
Set masterWB = Workbooks.Open("\\filepath\filename.xlsm")
Copysheets masterWB, "\\filepath\filename1.xlst"
Copysheets masterWB, "\\filepath\filename2.xlst"
Copysheets masterWB, "\\filepath\filename3.xlst"
Copysheets masterWB, "\\filepath\filename4.xlst"
masterWB.Save
End Sub
or, for example, use a loop to copy sheets of all files:
Sub CopyAllMyWorkbooks()
Dim masterWB As Workbook
Set masterWB = Workbooks.Open("\\filepath\filename.xlsm")
Dim sourceFilename As String
sourceFilename = Dir("\\filepath\filename*.xlst")
Do While sourceFilename <> ""
Copysheets masterWB, sourceFilename
sourceFilename = Dir
Loop
End Sub
I am currently working on a VBA script to automate a excel sheet. The goal is to have the code open a file from using a file path in cell A2 on a sheet called Reports (the file path is dynamic and is formed using information from the sheet) , copy the data from the file for range A1:E200 and to paste the data into the original workbook on a sheet called HOURS starting at A1. At the moment i have gotten to the point where the file is opened but there is a "Mismatch" error when trying to copy the information across. Below I've attached the code used. I was hoping that someone would be able to help to make sense of the error! I am having the same problem with the close section as well. Note: I am a rookie on VBA so if you could be as clear as possible
Sub Button1_Click()
Call Test
Call Copy_Method
Call CloseWorkbook
End Sub
Sub Test()
Dim strFName As String
strFName = Sheet4.Range("A2").Value
Workbooks.Open Filename:=strFName
End Sub
Sub Copy_Method()
'Copy range to another workbook using Range.Copy Method
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set wb2 = ThisWorkbook
Set ws2 = wb2.Sheets("HOURS")
Set wb1 = ThisWorkbook.Worksheets("Reports").Range("A2")
Set ws1 = wb1.Sheets("Sheet")
ws2.Range("A1:E200") = ws1.Range("A1:E200").Value
End Sub
Sub CloseWorkbook()
Workbooks("venues_theeway_hours_August2020.XLS").Close SaveChanges:=True
End Sub
Have you tried this ?
ws2.Range("A1:E200").Value = ws1.Range("A1:E200").Value
You're making life quite difficult for yourself there, splitting the code out across 3 subs. Better to
rename the references to make them easier to differentiate source/destination.
keep it all together so the workbooks/worksheets can still be referenced as they're created:
Apologies if I've misread your requirements, my code does the following:
Reads the original workbook, sheet "Reports", range A2 for a filename.
Opens that filename as a 'source' workbook
Copies data from..
that 'source' workbook, sheet "Sheet", range A1:E200
..to original workbook, sheet "HOURS", range A1:E200
and then closes the 'source' workbook, unsaved as you've not made any changes.
Dim wbSource As Workbook
Dim wbDest As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim strFName As String
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Sheets("HOURS")
strFName = wbDest.Worksheets("Reports").Range("A2").Value
Set wbSource = Workbooks.Open(strFName)
Set wsSource = wbSource.Worksheets("Sheet")
wsDest.Range("A1:E200").Value = wsSource.Range("A1:E200").Value
wbSource.Close SaveChanges:=False
I'm a little puzzled about your workbook close with save? Perhaps you actually want to close the source sheet unsaved and maybe save the destination sheet you're adding data to? In that case you'll need to add this line to the end of the above code.
wbDest.Close SaveChanges:=True
I want to have the VBA from workbook1 go into a specified folder, open the three workbooks that are within it, and copy the data from each one (each workbook within the folder only has one sheet with data) into workbook1.
I've looked around and alot of info for copying sheets; I can go in to the folder and copy the data if I have the workbook name and tab name, but these will change every time a new workbook is loaded (monthly).
Sub OpenWorkbook1()
'Open workbook
Workbooks.Open "P:\FSD\SUPPORT SERVICES\File Load\190731_CO.xls"
'Copy
Workbooks("190731_CO.xls").Worksheets("190731_CO").Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Paste
Workbooks("Dual Sub.xlsm").Worksheets("CO").Range("A2").PasteSpecial
Paste:=xlPasteValues
Application.CutCopyMode = False
Workbooks("190731_CO.xls").Close SaveChanges:=False
End Sub
The code above is ok, but I want to be able to open the workbooks each month, and the number (190731 in this case) will change monthly to a random number. There are 3 total workbooks I need to extract data from, the above only shows me collecting the data from one.
Based on what I gather from the description, the problem is the following.
The aim is to copy the content of the first sheet of three workbooks in a specified folder only containing these three workbooks into known workbook to sheets named after the letters following the last underscore.
This is actually not one problem, but three problems: find the workbooks, derive the correct sheet from the name and copy the content.
You have already dealt with the last problem, but in a not very generic way. The answers linked in the comments can help you with this further. However, since you are only concerned with the values, I would recommend to copy via an array.
Private Sub CopyValues(ByVal sourceRange As Excel.Range, ByVal targetRange As Excel.Range)
Dim copyArray as Variant
copyArray = sourceRange.Value
targetRange.Value = copyArray
End Sub
To get the name for the target sheet, you can use the VBA atring functions; in particular InstrRev Right and Split could be usefult. I will leave it to you to figure out a way to define a function Private Function TargetSheetName(ByVal sourceWorkbookName As String).
Using this information, you do the following.
Private Sub CopyFirstSheet(ByVal sourceWorkbook As Excel.Workbook, ByVal targetWorkbook As Excel.Workbook)
Dim sourceRange As Excel.Range
Set sourceRange = CopyRange(sourceWorkbook.Worksheets(1)
Dim targetSheetName As String
targetSheetName = TargetSheetName(targetWorkbook.Name)
Dim targetRange As Excel.Range
Set targetRange = targetWorkbook.Worksheets(targetSheetName).Range("A2")
End Sub
Here Private Function CopyRange(ByVal sourceWorksheet As Excle.WorkSheet) As Excel.Range is a function describing how you determine the copy range given the source worksheet.
Finally, there is the problem of finding the source workbooks. In the comments, it was suggested to use Dir. However, I would like to suggest a more readable approach. Unless you work on a Mac, you can refernce the library _Microsoft Scripting Runtime` under Tools->Refreences. This gives you access to the Scripting.FileSystemObject. You can use it as follows.
Private Sub CopyFromFolder(ByVal sourcePath As String, ByVal targetWorkbook As Excel.Workbook)
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
Dim file As Scripting.File
For Each file in fso.GetFolder(path).Files
Dim sourceWorkbook As Excel.Workbook
Set sourceWorkbook = Application.Workbooks.Open path & file.Name
CopyFirstSheet sourceWorkbook, targetWorkbook
sourceWorkbook.Close SaveChanges:=False
Next
End Sub
This assumes that only the three workbooks are in the folder. Otherwise, some more logic will be required.
I hope this is of help regarding the specific problem and in general on how to split such a problem into smaller problem that can be dealt with in separate procedures or functions.
I have MS Access producing a bunch of workbooks and worksheets. When a workbook is creates there are extra worksheets in the workbook named "Sheetn"
I know the following code works but my question is about timing.
Dim ws as excel.worksheet
For each ws in wbWorking.Worksheets
oxl.DisplayWarnings=False
If ws.name like "Sheet*" then ws.delete
oxl.DisplayWarnings=True
Next ws
The above code does not work until I save the Workbook. The issues is that the client is watching for the workbooks to populate the directory and will open them as soon as they show. This causes issues if the above code runs and the client has the workbook open. I would like to delete worksheets before the workbook is saved.
Please advise.
Working from when you first create the new workbook, something along these lines should work:
Public Function BuildWorkbook(wbkToCopy As Excel.Workbook) As Excel.Workbook
Dim xl As Excel.Application
Dim dummySheet As Excel.Worksheet
Dim sheetToClone As Excel.Worksheet
Dim i As Long
Set xl = wbkToCopy.Application
Set BuildWorkbook = xl.Workbooks.Add(1)
Set dummySheet = BuildWorkbook.Worksheets(1)
For Each sheetToClone In wbkToCopy.Worksheets
'This is just to handle naming conflicts
Do Until sheetToClone.Name <> dummySheet.Name
dummySheet.Name = Format(Now(), "yyyymmddhhnnss") & CStr(i)
i = i + 1
DoEvents
Loop
sheetToClone.Copy BuildWorkbook.Worksheets(1)
Next
If BuildWorkbook.Worksheets.Count > 1 Then
dummySheet.Delete
End If
End Function
Obviously, you can add the sheets however you need to, but the keys are:
Specify =Workbooks.Add(1) when you create the new workbook, so it is created with only 1 worksheet
Set a reference to the worksheet that you don't want when you first create the new workbook
Using that initial reference, delete the worksheet at the very end of the process, before saving the workbook
I have 54 excel files with three sheets each, each sheet has a different amount of data entries but they are set out in a identical format, and I need to import the data from those sheets into a single workbook using VBA.
Is there any way I can program it so I can build the loops to import the data, but without having to write in each workbook name for each loop/sheet? I think I can use the call function, but I don't know how to make the loop codes independent of the workbook name they apply to.
Thank you so much in advance,
Millie
Sure just loop over the workbooks in a folder open them and then loop over their sheets. Depending on slight differences in format you might need to do some extra work when importing.
Sub ImportWorkbooks(destination as workbook, importFolderPath As String)
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object associated with the directory
Set objFolder = objFSO.GetFolder(importFolderPath)
'Loop through the Files collection and import each workbook
For Each objFile In objFolder.Files
Dim source As Workbook
Set source = Application.Workbooks.Open(objFile.Path, ReadOnly:=True)
ImportWorkbook source, destination
wb.Close
Set wb = Nothing
Next
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End Sub
Sub ImportWorkbook(source As Workbook, destination as Workbook)
Dim sheet As Worksheet
'Import each worksheet
For Each sheet In source.Sheets
ImportWorksheet sheet, destination
Next sheet
End Sub
Sub ImportWorksheet(sheet As Worksheet, destination as Workbook)
'Perform your import logic for each sheet here (i.e. Copy from sheet and paste into a
'sheet into the provided workbook)
End Sub
Basic usage would be something like the following to import into the current workbook:
ImportWorkbooks ThisWorkbook, "c:\path\to\folder\containing\workbooks\to\import"
It only takes two things:
An array with the workbook file names in it, e.g.
dim books
books = array("book1.xls","book2.xls",....)
Then your loop code looks something like
dim myBk as Workbook
dim bkFile as string
For Each bkFile in books
myBk = Workbooks.Open(bkFile, ReadOnly)
myBk.Activate
'Transfer cells from myBk to target workbook
target.cells(--).Value = myBk.Sheets("myStuff").Cells(--)
...
Next
I can't help you with the detail. You'll need to change the target.cells argument for each pass through the loop to shift the data destination.