VBA - Cut & Paste cells between workbooks - vba

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

Related

Stay in the active workbook after opening other workbooks

I am trying to open two other Excel workbooks to take data to do my calculation through the macro. I have a working code to open those files.
Dim wbCount As Integer
Application.ScreenUpdating = False
For wbCount = 1 To 2
Workbooks.Open Filename:=ThisWorkbook.Path & "\Installation Sheet " & wbCount & ".xlsm", UpdateLinks:=False
Next wbCount
ThisWorkbook.Activate
Application.ScreenUpdating = True
The other files are named "Installation Sheet 1" and "Installation Sheet 2". After this code runs, I end up with "Installation Sheet 1" displaying instead of my active workbook.
Put your ActiveWorkbook into a variable at the appropriate place and then use that to move back. ThisWorkbook is the one with code in. So be sure if you mean ActiveWorkbook or ThisWorkbook, or if ThisWorkbook is the ActiveWorkbook at the time. In that case, you can simply Set wb = ThisWorkbook
Dim wb As Workbook
Set wb = ActiveWorkbook
'Set wb = ThisWorkbook '<== If you want the workbook containing the code
'Other code
wb.Activate
You have to put your workbooks references into variables and then using these variables you have two options: close newly opened workbook, so only original stays opened or use Activate method to bring the original workbook to front.
Sample code:
Sub OpeningWb()
Dim wb As Workbook, currentWb As Workbook
Set currentWb = ThisWorkbook
Set wb = Workbooks.Open("your path here")
' if you want to close opened workbook
'wb.Close
' if you want to bring to front original workbook
currentWb.Activate
End Sub
Alternatively, you can do the following:
Dim wbToDisplay As Workbook
Set wbToDisdplay = Workbooks("workbook name here")
wbToDisplay.Activate
The above solutions didn't work for me, because activate method is fired before second workbook is displayed, so I get active this second workbook always. My workaround is wait a couple of seconds before calling Activate method:
Dim t: t = Timer
While Timer < t + 2 'wait for 2 seconds
DoEvents
Wend
ThisWorkbook.Activate

Vba Excel error using SaveAs with password

I wrote a simply code to save every Excel Worksheet as a new file (.xlsx) protected with password:
For i = 1 To 7
ThisWorkbook.Sheets(i).Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & i & ".xlsx", FileFormat:=51, Password:="XXX"
ActiveWorkbook.Close False
Next i
It works but the error is that the created files seem to have a sort of autorun (they auto-open if you simply click on the icons) and then the Excel popup about password shows "copy of && is protected" in adding to "&& is protected" and ask for the password twice.
Any ideas?
Thanks
A general peace of advice, do not use ThisWorkbook, ActiveWorkbook, Active Worksheet etc. if not 100% neccessary. It more often than not causes problems. Second thing, sometimes a few more lines of code are better than less, because of debugability.
The most important points of code below: Your workbook of source is defined as wbSource and you initialize a variable wbTarget. For each worksheet in the workbook you create a new workbook by Set wbTarget = Workbooks.Add copy the sheet mySheet the iterator to it, set the password and save it. This can be done in one row, but again this is very clear and debugable.
Sub test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wbSource As Workbook, wbTarget As Workbook
Dim wsToCopy As Worksheet
Set wbSource = ThisWorkbook
For Each mySheet In wbSource.Sheets
Set wbTarget = Workbooks.Add
mySheet.Copy Before:=wbTarget.Sheets(1)
wbTarget.Password = "XXX"
wbTarget.Close True, mySheet.Name
Next mySheet
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

excel VBA error: The object invoked has disconnected from its clients

It seems a normal question and I have searched and tried many suggestions here but the error persists. I want to copy a "case1" sheet from current workbook to an existing workbook(file name is "workbook2.xlsx", it has a worksheet named "case2"), then save the workbook and close it. Sometimes it works well, but most of the time I kept getting the same error. In fact I did not change any code so I don't know where went wrong.
The error shows "The object invoked has disconnected from its clients". It always breaks in the same place:
ThisWorkbook.Sheets("case1").Copy Before:=ActiveWorkbook.Sheets("Case2")
Sub CopySheet()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'open existing "workbook2.xlsx"
Workbooks.Open filename:="c:\workbook2.xlsx"
'copy a sheet named "case1" from current workbook to "workbook2.xlsx" which already has a sheet named "case2"
ThisWorkbook.Sheets("case1").Copy Before:=ActiveWorkbook.Sheets("Case2")
'close "workbook2.xlsx"
Workbooks("workbook2.xlsx").Activate
ActiveWorkbook.Close SaveChanges:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Always set references to sheets and workbooks, then there is no chance of confusing which is which. This code does the same thing and should not give you any errors.
Sub CopySheet()
Dim wb1 As Workbook, ws1 As Worksheet 'Source
Dim wb2 As Workbook, ws2 As Worksheet 'Target
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("case1")
Set wb2 = Workbooks.Open("c:\workbook2.xlsx")
Set ws2 = wb2.Sheets("case2")
ws1.Copy Before:=ws2
wb2.Close True
End Sub

Copy (Import) cells from another spreadsheet into active sheet

I'm a very novice VBA programmer. I only get to do it in my downtime between work things. Anyways I have been working on an incident tracker for myself and colleagues and to help them out when I update it with new features I have been trying to add an "Import" feature.
The thing is there is a separate worksheet for each month (Jan to Dec and another sheet for overtime called OT). The code needs to copy from the correct sheet and paste into the sheet with the same name.
I can't quite get it to work though. This is what I have so far:
'Import Incident
Sub ImportIncidents()
Dim OpenFileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim myRng As Range
Dim MyWB As Workbook
'store the current workbook in a variable
Set MyWB = ActiveWorkbook
'Select and Open workbook
OpenFileName = Application.GetOpenFilename
If OpenFileName = False Then
MsgBox ("Import Failed!")
Exit Sub
End If
Set wb = Workbooks.Open(OpenFileName, UpdateLinks:=0)
'Get data
wb.Activate
For Each ws In wb.Worksheets
Set myRng = ws.Range("A6:AV45")
myRng.Copy
MyWB.Activate
Set myRng =
wb.Activate
Next
MsgBox ("Import Complete!")
End Sub
If anyone could help me out that would be amazing. I am sure I will be able to get the hang of it after I work through my VBA book properly (VBA for Dummies, ahah!) But I am having trouble finding a weekend to sit down and do it when I do a lot of overtime.
Your code isn't bad at all for a beginner. Assuming you are copying to the same range in the other sheet you only need one line in your for loop.
myRng.Copy Destination:=MyWB.Worksheets(myRng.Name).Range("A6:AV45")
This will copy everything including the formatting.
Please try the following:
If OpenFileName = "False" then
I tested from my machine and if you DIM OpenFileName as String than it will pass "False" into OpenFileName if you select nothing.
PS: Both OpenFileName = False and OpenFileName = "False" work on my end, so do anyone got the answer?
Apologies that I have not been on to respond to the suggestions that you have given me. Everything that was said helped.
Paul, listing as a Variant was the right way to go, and Thomas, the "" also helped get past the error. Unfortunately after I had done these I was met with a 400 error so there was an issue with something I had done.
In the end I was able to figure it out and the following code works... In a very crude way:
'Import Incident
Sub ImportIncidents()
Dim OpenFileName As Variant
Dim wb As Workbook
Dim ws As Worksheet
Dim myRng As Range
Dim MyWB As Workbook
'store the current workbook in a variable
Set MyWB = ActiveWorkbook
'Select and Open workbook
OpenFileName = Application.GetOpenFilename
If OpenFileName = False Then
MsgBox ("Import Failed!")
Exit Sub
End If
Set wb = Workbooks.Open(OpenFileName, UpdateLinks:=0)
'Import Data
wb.Activate
Application.DisplayAlerts = False
For Each ws In wb.Worksheets
Set myRng = ws.Range("A6:AV45")
myRng.Copy Destination:=MyWB.Worksheets(myRng.Parent.Name).Range("A6:AV45")
'ActiveWorkbook.Close = False
MyWB.Activate
Next
Application.DisplayAlerts = True
MsgBox ("Import Complete!")
End Sub
This is a great start and I am now working on having it only go through the sheets I want it to by using a for loop linked to the months of the year (which is how the sheets are laid out. I dont need to copy the data sheets after all as that may cause problems).
Thanks for all your help

Excel 2003 VBA: Move a sheet into a new workbook that is referenced by a variable

I have a function that is meant to run the ShowPages() command of a PivotTable and then save each sheet to a separate file.
Here's how I wish I could do it:
Sub Split()
ThisWorkbook.Sheets("Data").PivotTables("Data").ShowPages PageField:="Codename"
Dim newWb As Workbook
For Each s In ThisWorkbook.Sheets
If s.Name <> "Data" Then
Set newWb = s.Move #This is the line I'm trying to work out
newWb.SaveAs Filename:="C:\Export\" + s.Name + ".xls"
newWb.Close
End If
Next s
End Sub
Unfortunately, this is running into a bunch of issues to do with not having created objects and suchlike (understandably). What is the most sensible way to do this?
Sub Split()
ThisWorkbook.Sheets("Data").PivotTables("Data").ShowPages PageField:="Codename"
Dim newWb As Workbook
For Each s In ThisWorkbook.Sheets
If s.Name <> "Data" Then
''Added by Soldieraman
Dim sheetName As String
sheetName = s.Name
Set newWb = Workbooks.Add
s.Move before:=newWb.Sheets(1)
Application.DisplayAlerts = False
newWb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
''Edited by soldieraman
newWb.SaveAs Filename:="C:\Export\Test" & sheetName & ".xls"
newWb.Close
End If
Next s
End Sub
Although this is old, and the accepted answer by soldieraman is very nice, just wanted to add one thing. The Excel VBA Sheets.Copy and Sheets.Move methods have a very nice feature. They take either of two optional arguments, "Before" or "After", to position a moved/copied sheet. The Excel documentation notes that:
If you don't specify either Before or After, Microsoft Excel
creates a new workbook that contains the moved [copied] sheet.
So, it is almost surprising, but you can just say:
Sheets(sheetname).Move
in the accepted answer, in place of:
Set newWb = Workbooks.Add
s.Move before:=newWb.Sheets(1)
Application.DisplayAlerts = False
newWb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
Application.DisplayAlerts = True
The rest of soldieraman's code would work fine with this simplification.