I'm attempting to copy data from one workbook to another. After some browsing on the internet this is the code i found and it produces a run-time error 1004
Sub Name_Transfer()
Dim wbSource As Workbook
Dim wbDestination As Workbook
'open the source workbook and select the source sheet
Set wbSource = Workbooks.Open( _
Filename:="C:\TestFolder\2013 Cockpit Chart.xls")
'Set the destition workbook variable
Set wbDestination = Workbooks("U:\my documents\ATM Platform 2013\Advanced Team Management.xlsm")
'copy the source range
wbSource.Sheets("Sheet1").Range("A2:B4").Copy
'paste the value at E9
wbDestination.Sheets("DataStore").Range("A4:B6").Value = _
wbSource.Sheets("Sheet1").Range("A2:B4").Value
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub
What is causing the 1004 error? Can it be fixed? or is there a far better way to be doing this?
Number of rows in source do not match with number of rows in destination.
Try this
wbDestination.Sheets("Delivery").Range("A4:B6").PasteSpecial (xlPasteValues)
or
wbDestination.Sheets("DataStore").Range("A4:B6").Value = _
wbSource.Sheets("Sheet1").Range("A2:B4").Value
Also specify the path for
Set wbDestination = Workbooks("Advanced Team Management.xlsm")
like you did for wbSource in case Advanced Team Management.xlsm is closed.
forgot to mention this was being done in Excel 2007...
The reason behind the 1004 error was it was looking for a .xls file not a xlsx file
so the code should of looked like this
'open the source workbook and select the source sheet
Set wbSource = Workbooks.Open( _
Filename:="C:\TestFolder\2013 Cockpit Chart.xlsx")
To close the file i just used
ActiveWorkbook.Close
Or as Siddharth so rightly said to use:
wbSource.close savechanges:= false
Thanks for your help contributors... I probably would of never seen this without all your help.
Related
I'm looking for assistance regarding how to write a VBA command that allows me to copy a range of cells from different workbooks onto one master sheet. Let me explain further.
Everyday I receive a new excel document from my clients named based on the date it was uploaded ie. September 18, 2018 file would be called A20180918.
Once i've received a week's worth of excel files (A20180918-A20180921), I then have to copy certain information from the original uploaded file to a master tracking sheet.
So, my hurdle is such that each time I record my actions into a macro, the code includes the file name which then creates a subscript error when it's run on the next day's file.
So here's an example below of the code I have this far:
Sub CopyRange()
CopyRange Macro
'This is the line of the code that's causing problems given it's a specified workbook name
'and when I try to open tomorrow's workbook i'll run into the subscript error.
Windows("A20180914.xls").Activate
Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Master Sheet.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Thank you!
Here's two solutions. One to scan an Directory for files, and the other to select files. I see they've both been suggested in the comments already. :p
Sub Test()
' If you want to scan an "unprocessed files" directory
'Call ScanDir("C:\Test\")
' If you want to select files to process
Call SelectFiles
End Sub
Private Sub ScanDir(ByVal DirPath As String)
Dim oCurFile As String
oCurFile = Dir(DirPath)
Do While oCurFile <> ""
' Add the work to the file here
' Filename: DirPath & oCurFile
oCurFile = Dir()
Loop
End Sub
Private Sub SelectFiles()
Dim oFileDialog As FileDialog
Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
oFileDialog.AllowMultiSelect = True
If oFileDialog.Show = -1 Then
Dim oFile As Variant
For Each oFile In oFileDialog.SelectedItems
' Add the work to the file here
' Filename: oFile
Next
End If
End Sub
By the looks of it you have all the workbooks open when you run the code - there are ways to have the code open each workbook in a certain folder, or ask the user to select them.
While writing this other answers have given the code for selecting files from folders.
Each workbook in the Excel Application is held in a collection of workbooks. The good thing about collections is you can step through them without know the specifics before you get there.
The code below will print the name of each workbook you have open into the immediate window. Note - these are in the same instance of Excel. If you open Excel a second time then any workbooks in that application will be in a different collection.
You don't really need the Application but I left it in to make things a bit clearer.
Sub Test()
Dim bk As Workbook
For Each bk In Application.Workbooks
Debug.Print bk.Name
Next bk
End Sub
This is the full code - note that nothing is Selected.
Sub Test()
Dim bk As Workbook
Dim Master As Workbook
Dim LastCell As Range
Set Master = Workbooks("Master Sheet.xlsm")
For Each bk In Application.Workbooks
'Checks the middle part of the file name - should be a number.
'Better ways to check the file name are available.
If IsNumeric(Mid(bk.Name, 3, 8)) Then
'Copy date from Sheet1. It's assumed each row in
'column B is populated and figures out the last cell from there.
With bk.Worksheets("Sheet1")
Set LastCell = .Cells(.Rows.Count, 2).End(xlUp)
.Range("A1", LastCell).Copy
End With
'Pastes the results to Sheet1 in the Master workbook.
'The last cell containing data in column A is found and
'then offset by 1 row.
With Master.Worksheets("Sheet1")
.Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End With
End If
Next bk
End Sub
This will do it, you just need to supply the sheet name and ranges where noted:
Sub copyRange()
'File system variables
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim myDir As String
Dim Mask As String
'Workbook variables
Dim wb As Workbook
Dim sh As Worksheet
myDir = "C:\Users\Guest\Desktop" 'Insert the path where your incoming files are stored.
Mask = "*.xl??" 'This makes it so it only looks at Excel files.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getFolder(myDir)
For Each objFile In objFolder.Files
If LCase(objFile.Name) Like LCase(Mask) Then
Set wb = Workbooks.Open(myDir & "\" & objFile.Name, , True) 'This is set to open in read only, to avoid issues with the file already being open
'The ranges you are copying/pasting are vague, supply the sheet names and ranges below
'Get Copy range with dynamic number of rows.
With wb.Sheets("Sheet1").Range("A2:B2") '<---- Specify Sheet/Range
Set copyRange = .Resize(.End(xlDown).Row, 2)
End With
'Get next available row in paste range.
With ThisWorkbook.Sheets("Sheet1").Range("G:H") '<---- Specify Sheet/Range
Set pasteRange = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
copyRange.Copy pasteRange
wb.Close False
End If
Next objFile
End Sub
I am creating a workbook which will be used as a template for monthly reports (let's call it 'ReportWorkbookTest') and am struggling to write or record a macro which will paste data into the ReportWorkbookTest from various, unspecified workbooks.
To create the monthly reports, data is exported from a server to a .xlsx file named by the date/time the report was exported. Therefore, the name of the workbook which information will be pasted form will always have different names. The columns that the information in the monthly data exports will always remain the same (columns D:G & I). I've managed to do this for two specified workbooks but cannot transpose to new monthly data exports.
Range("I4").Select
Windows("Export 2018-06-21 11.51.34.xlsx").Activate
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=9, Criteria1:= _
xlFilterLastMonth, Operator:=xlFilterDynamic
Range("D2:G830,I2:I830").Select
Range("I2").Activate
Selection.Copy
Windows("ReportWorkbookTest.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Is there a way to set up the VBA so that the workbook names do not need to be specified while running the macro? Also, how do I specify that the macro only copies the active rows in the table if the number of rows changes per export?
Thanks!
If only these two workbooks will be open you can use numbers instead of the name:
Workbooks(1)
and
Workbooks(2)
Workbooks(1) will be the one that was opened first, more likely ReportWorkbookTest.xlsm where the macro will be, so you can provide instructions that this file should be opened first. If more than these two workbooks will be open you can try a loop approach, here is an example to use:
Dim wkb as Workbook
Dim thisWb as Workbook
Dim expWb as Workbook
Set thisWb = ThisWorkbook
For Each wkb in Workbooks
If wkb.Name Like "Export 2018-*" Then
expWb = wkb
Exit For
End If
Next
If Not expWb Is Nothing Then
'Found Export, do stuff like copy from expWb to thisWb
expWb.Worksheets(1).Range("B20:B40").Copy
thisWb.Sheets("PasteSheet").Range("A3").PasteSpecial xlValues
Else
'Workbook with Export name not found
End If
This is your framework, if you have multiple files to import then I would suggest a wizard instead.
Wizard framework would be:
1) prompt the user to select a file (of a certain type you might check for, can be a column name - header)
2) if it passes validation then import the data (and process it)
2b) if doesn't pass report it wasn't a valid file and prompt again
3) prompt for the next file type
......
I have a project like this that takes 4 different data "dumps" and merges them into a summary workbook each month.
But for a single file of changing name, here you go for a framework:
you can eliminate cycling through all of the worksheets if there is only one
you might also not be appending data to what already exists, but that is what finding the new last row is for.
Option Explicit
'Sub to get the Current FileName
Private Sub getFN()
Dim Finfo As String
Dim FilterIndex As Long
Dim Title As String
Dim CopyBook As Workbook 'Workbook to copy from
Dim CopySheet As Worksheet 'Worksheet to copy from
Dim FN As Variant 'File Name
Dim wsNum As Double 'worksheet # as you move through the Copy Book
Dim cwsLastRow As Long 'copy worksheet last row
Dim mwsLastRow As Long 'master worksheet last row
Dim masterWS As Worksheet 'thisworkbook, your master worksheet
Dim rngCopy1 As Range
Dim rngCopy2 As Range
Set masterWS = ThisWorkbook.Worksheets("Master Security Logs")
'Set up file filter
Finfo = "Excel Files (*.xls*),*.xls*"
'Set filter index to Excel Files by default in case more are added
FilterIndex = 1
' set Caption for dialogue box
Title = "Select the Current AP Reconcile Workbook"
'get the Forecast Filename
FN = Application.GetOpenFilename(Finfo, FilterIndex, Title)
'Handle file Selection
If FN = False Then
MsgBox "No file was selected.", vbExclamation, "Not so fast"
Else
'Do your Macro tasks here
'Supress Screen Updating but don't so this until you know your code runs well
Application.ScreenUpdating = False
'Open the File
Workbooks.Open (FN)
'Hide the file so it is out of the way
Set CopyBook = ActiveWorkbook
For wsNum = 1 To CopyBook.Sheets.Count 'you stated there will be 8, this is safer
'Do your work here, looks like you are copying certain ranges from each sheet into ThisWorkbook
CopySheet = CopyBook.Worksheets(wsNum) '1,2,3,4,5,6,7,8
'Finds the lastRow in your Copysheet each time through
cwsLastRow = CopySheet.Cells(CopySheet.Rows.Count, "A").End(xlUp).Row
'Set your copy ranges
Set rngCopy1 = CopySheet("D2:D"&cwsLastRow) 'this is your D column
Set rngCopy2 = CopySheet("I2:I"&cwsLastRow) 'this is your I column
'so you would have to keep tabs on what the lastRow of this sheet is too and always start at +1
mwsLastRow = masterWS.Cells(masterWS.Rows.Count, "A").End(xlUp).Row
'Copy the ranges in where you want them on the master sheet
'rngCopy1.Copy destination:= masterWS.Range("D"&mwsLastRow+1)
'rngCopy2.Copy destination:= masterWS.Range("I"&mwsLastRow+1)
'Clear the clipboard before you go around again
Application.CutCopyMode = False
Next wsNum
End If
'Close the workbook opened for the copy
CopyBook.Close savechanges:=False 'Not needed now
'Screen Updating Back on
Application.ScreenUpdating = True
End Sub
Dim wbTarget As Workbook
Dim wbSource As Workbook
Set wbTarget = ThisWorkbook
Set wbSource = Workbooks.Open("C:\Users\alibe\Desktop\PoS\Alain.xlsx")
wbSource.Worksheets("Spain").Range("plage_sp").Copy
wbSource.Activate
Set wbTarget = ThisWorkbook
wbTarget.Worksheets("Feui1").Range("A1").PasteSpecial xlPasteAll
wbTarget.Save
wbTarget.Close
Hi everybody,
I am trying to cut and paste cells between two different workbooks. But I got failure 9 or 438 in my Paste line. May somebody give a help please.
There's a couple things we want change.
First, it's good practice to get into the habit of having excel check whether your file location exists or not. You might think you have it put in correctly, but it's always best to make sure excel feels the same way. (This also makes your code more flexible for later use.)
When opening workbooks and closing them, there's no reason to bog your system down trying to open new windows quickly. Since we don't need to see what it's doing, just that it's done it, we can turn ScreenUpdating and DisplayAlerts to false until the end of our code.
You should check the spelling on your worksheet "Feui1", that it's not actually "Feuil".
For the application of defining different ranges by workbook, we need to use .Sheets() object instead of .Worksheets()
Also, it's not common to see that you have this code in the same file that you're closing, when you're opening another file. At the end of this routine, ThisWorkbook is going to close, and wbSource will be left open. Is this intentional? Just something I thought I'd point out.
Sub CopyPasta()
Dim wbTarget As Workbook: Set wbTarget = ThisWorkbook
Dim wbSource As Workbook, sourceFile As String
sourceFile = "C:\Users\alibe\Desktop\PoS\Alain.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Dir(sourceFile) = "" Then 'Checks that file location exists
MsgBox "File not found.", vbCritical, "Bad File Address"
Exit Sub
End If
Set wbSource = Workbooks.Open(sourceFile)
wbSource.Sheets("Spain").Range("plage_sp").Copy
wbTarget.Sheets("Feuil").Range("A1").PasteSpecial xlPasteAll 'Spelling on 'Feuil'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
wbTarget.Save
wbTarget.Close 'You want to close the workbook that this code is in?
End Sub
Few changes
Dim wbTarget As Workbook
Dim wbSource As Workbook
Set wbTarget = ThisWorkbook
Set wbSource = Workbooks.Open("C:\Users\alibe\Desktop\PoS\Alain.xlsx")
wbSource.Sheets("Spain").Range("plage_sp").Copy
wbTarget.Sheets("Feui1").Range("A1").PasteSpecial Paste:=xlPasteAll
wbTarget.Save
wbTarget.Close
I don't know why, I just can't get this to work. I've simplified it right down to just three lines - but it's causing me problems still.
Basically I want to open a workbook and copy some data from it into a master workbook.
I have:
Sub copypaste()
Workbooks.Open("...Test.xlsx").Sheets("Sheet1").Cells(1, 1).Copy
ActiveWorkbook.Close
Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
End Sub
I've seen runtime error 438 (object does not support this property method), I can get paste that but just hit 1004 application defined error or object defined error.
I honestly have no idea where I'm going wrong on this simple task!
Thank you in advance,
Tom
Try closing the workbook after pasting the data.
As an example you can use something like:
Sub copypaste()
Dim WBopen As Workbook, Wb As Workbook
Set Wb = ActiveWorkbook
Set WBopen = Workbooks.Open("...Test.xlsx")
WBopen.Sheets("Sheet1").Cells(1, 1).Copy
Wb.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
WBopen.Close
End Sub
Because you are closing the Workbook before the data is pasted it fails.
It is also preferred to not use .Copy and .Paste when it can be avoided.
See example below for a direct setting of the Values:
Sub copypaste()
Dim wbMaster As Workbook, wbData As Workbook
Set wbMaster = Workbooks("Master.xlsm")
Set wbData = Workbooks.Open("Data.xlsx")
wbMaster.Sheets("Sheet1").Range("A1").Value = wbData.Sheets("Sheet1").Range("A1").Value
wbData.Close False
End Sub
Despite many posts I have looked through being of along the same lines as my question, none of the answers satisfy what I am looking for. If you can link me to one I'd gladly read it.
I have a workbook with worksheets. For simplicity, let's say my workbook has a worksheet. And in my worksheet which is called "Sheet1", there is data in cells A1 to A4.
What I want my VBA code to do is:
Copy row 1 (or specifically cells A1 to A4) of Workbook 'A' into Range variable 'myRange'
Create a new workbook, let's call this one Workbook 'B'
Give Workbook 'B's default "sheet1" a new name to "Test Name"
Open Workbook 'B' (though I realise that VBA code "Workbooks.Add" opens a new book so this step may be redundant since Workbooks.Add covers half of point 2 and 3)
Paste 'myRange' into first row of 'Workbook B'
Save 'Workbook B' with name "Test Book" and a timestamp enclosed in square brackets. The file must also be of the file extension "xls"
Close 'Workbook B' and return to 'Workbook A'
What I have so far is this:
Sub OpenAndSaveNewBook()
'Declarations
Dim MyBook As String
Dim MyRange As Range
Dim newBook As Workbook
'Get name of current wb
MyBook = ThisWorkbook.Name
Set MyRange = MyBook.Sheets("Sheet1").Range("A1,F1")
'Create/Open new wb
newBook = Workbooks.Add
'Save new wb with XLS extension
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "/" & "TEST-BOOK", _
FileFormat:=xlNormal, CreateBackup:=False
'===NOTE: BEFORE THE FOLLOWING RUNS I NEED TO PERFORM ACTIONS ON CELLS VIA VBA ON
'===WORKBOOK 'A'. DOES THE NEWLY CREATE WORKBOOK BECOME THE PRIMARY/ACTIVE WORKBOOK
'===? AND SO THEN DO I NEED TO ACTIVATE WORKBOOK 'A'?
ActiveWorkbook.Close savechanges:=True
'Return focus to workbook 'a'
MyBook.Activate
End Sub
As you can see, I am lacking the code that will handle:
the pasting of my copied data to the new workbook
the changing of the new workbook's sheet1 name to something else
adding a timestamp to the filename string on save
Lastly, I have included a question in my code as I think I may have a misunderstanding of the ActiveWorkbook method. AFAIK when the code "Workbooks.Add" runs this becomes the Active Workbook, i.e. one with the focus. Does this effect how the VBA code running on Workbook 'A'? Does this mean that if I wanted to add code to manipulate cells of Workbook 'A' then I would need to use "MyBook.Activate" where 'MyBook' holds the string of Workbook 'A's actual title?
Any help will be greatly appreciated.
Thanks,
QF
Instead of copy pasting the way you mentioned above, you can directly do this. This will also negate the use of a variable.
MyBook.Sheets("Sheet1").Rows("1:4").copy _
newBook.Sheets("Sheet1").Rows("1")
EDIT
I just noticed an error with your code.
newBook = Workbooks.Add
This line will give you an error as you have to use Set
Your code can be written as
Option Explicit
Sub OpenAndSaveNewBook()
Dim MyBook As Workbook, newBook As Workbook
Dim FileNm As String
Set MyBook = ThisWorkbook
FileNm = ThisWorkbook.Path & "\" & "TEST-BOOK.xls"
Set newBook = Workbooks.Add
With newBook
MyBook.Sheets("Sheet1").Rows("1:4").Copy .Sheets("Sheet1").Rows("1")
'Save new wb with XLS extension
.SaveAs Filename:=FileNm, FileFormat:=xlNormal, CreateBackup:=False
.Close Savechanges:=False
End With
End Sub
MORE EDIT
Elaborating on the use of SET
I would recommend you to see this post.
LINK: Worksheets does not work
Avoid references to ActiveWorkbook in favour of explicit references wherever possible.
As you've found, it can be confusing knowing what's currently active, and you do not need to activate a workbook to manipulate it.
So you should be using
newBook.SaveAs...
newBook.Close...
Recorded macros tend to activate workbooks in order to work on them, but that's because that's the way a human who recorded them works! All activation really does is change focus.
The same applies to making selections and then manipulating the current selection; it's not necessary in VBA and tends to be slower than direct manipulation.
The awesome thing about Excel is the 'Record Macro' function. I started recording a macro and just followed the steps you outlined, then made a few minor modifications to the code that Excel provided as the recorded macro:
Range("A1:F1").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Sheets("Sheet1").Name = "Test Name"
Application.CutCopyMode = False
myNewFileName = myPath & myTestName & "_" & Date & ".xls"
ActiveWorkbook.SaveAs Filename:=myNewFileName _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
The Date function returns the current system date. It is important to note that the square brackets that you wanted are not valid filename characters; Excel will throw an error if you try to use those.
Turn the macro-recorders on; carefully execute the steps you want; stop the recorder; "edit" the macro generated. Fix as you need to make the program you intend, e.g., to parameterize it.