PDA

View Full Version : Solved: open with filedialog and copy to my workbook



pototoj
03-13-2013, 12:31 PM
HI I hope som can help me with a code for this.
I have a worksheet with a button. I need a code that can, when i press the button, open a filedialog. I select the excelfile, it open and copy Sheet1 from here to my workbook (with the button) into sheet 3.
It only have to be whats inside the sheet. Not the sheets name.
Hope some can help. P.s dont have so much experisence with macroes.

Potj

SamT
03-13-2013, 02:20 PM
pototoj,

First record a new macro, Maybe named OpenFile. Record what you do to open the file you want. Use Ctrl+O to start the dialog. Select the best "files of Type" from the dialog.

Then go back to your first workbook and record another macro, maybe named GetSheetContents. Record what you do to select the sheet's contents and paste them into Sheet3.

Copy both macros' Codes and paste them into a message here. Be sure to use the VBA button to put VBA tags around your macro codes.

pototoj
03-13-2013, 10:52 PM
HI Sam and thanks.
I found a macro for the openfiledialog and recorded the copy after. So i think it just to make the second macro so it can be used to other files too. Please have a look.


Sub Getopenfile()
strFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls")
If strFilename = False Then Exit Sub ' to exit if Cancel button pressed
Workbooks.Open (strFilename) ' Opening workbook indicated by passed name
End Sub




Sub Macro1()
' Macro2 Macro

Windows("HOGART-01.2013.xls").Activate
Cells.Select
Selection.Copy
Windows("PolandVlookup.xls").Activate
Sheets("Sheet3").Select
Cells.Select
ActiveSheet.Paste
Range("O30").Select
Windows("HOGART-01.2013.xls").Activate
ActiveWindow.Close
Application.WindowState = xlMinimized
Sheets("Program").Select
End Sub

SamT
03-14-2013, 09:13 AM
pototoj,

In this post I will try to explain how to clean up a recorded macro. For this explanation, I will first remove all the Names because the names are not significant.
Sub Macro1()
' Macro2 Macro

'Copy some Cells From one Workbook
Windows(X).Activate
Cells.Select
Selection.Copy

'Paste in a Worksheet
Windows(Y).Activate
Sheets(X).Select
Cells.Select
ActiveSheet.Paste

'Select a range, don't use it anywhere
Range(X).Select

Close a workbook'
Windows(X).Activate
ActiveWindow.Close

'Minimize the ActiveWorkbook(Y) Window
Application.WindowState = xlMinimized

'Select a sheet form another Workbook(Z?), not used.
Sheets(X).Select
End Sub Because Excel has no intelligence it must record every step. But VBA does not need to Activate and Select things in order to do work on them. It just has to know what to work on.

The first step in changing from using Activated objects to using the objects themselves is to remove all Activate methods.

Sub Macro1()
' Macro2 Macro

Copy All the Cells
Windows(X).Cells.Select
Selection.Copy

Paste to all the Cells
Windows(Y).Sheets(Y).Select
Cells.Select
ActiveSheet.Paste

'Range(X).Select ' Not used

'Close the copy from Workbook
Windows(X).Close

' You decide if this is needed
Application.WindowState = xlMinimized
Sheets(X).Select
End Sub
Note that where the macro first activated a window, then used ActiveWindow.Close, I deleted both the Actvate and the ActiveWindow statements because the one immediately followed the other. I did not remove the ActiveSheet paste at this time.

The next step is to remove all the select Methods using the same technique. Find the object to be used after all the selecting and use it directly

Sub Macro1()
' Macro2 Macro

Windows(X).Cells.Copy
Windows(X).Sheets(Y).Cells.Paste
Range(X).Select
Windows(X).Close
Application.WindowState = xlMinimized
Sheets(X).Select
End Sub
Especially look at the "Windows(X).Sheets(Y).Cells.Paste" statement and understand how I got there.

We want this procedure to work with Workbooks, not Windows. The Macro Recorder only "knew" that you were changing from one Workbook Window to another. The sheet you wanted to copy was already Active, so you didn't have to select it.
Sub Macro1()
' Macro2 Macro

Workbooks(X)Sheets(X).Cells.Copy
Workbooks(Y).Sheets(Y).Cells.Paste
Workbooks(X).Close
End Sub The Cells property of a Worksheet returns all the Cells on the Worksheet.

Compare this to Sheets(X).Cells(2, 4) which returns the 2nd row, 4th column Cell. Also compare Sheets(X).Cells(4065) which returns the 4065th cell on the sheet counting from left to right, then down one row and counting from L to R again.

Cells works the same for a Range. Range(X).Cells (2, 1) Returns the cell in the 1st column of the 2nd row in the Range.

SamT
03-14-2013, 09:44 AM
Pototoj,

Now we can write a procedure that runs the Dialog, copy and pastes a sheet contents and closes the copied workbook.

This is what we will work with:

Sub Getopenfile()
strFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls")
If strFilename = False Then Exit Sub ' to exit if Cancel button pressed
Workbooks.Open (strFilename) ' Opening workbook indicated by passed name

Workbooks(X)Sheets(X).Cells.Copy
Workbooks(Y).Sheets(Y).Cells.Paste
Workbooks(X).Close
End Sub

All we really have to do is insert the names as needed.


Sub Getopenfile()
Dim strFilename As String
Dim CurrentBook As String
CurrentBook = ThisWorkbook.Name

''''Get the book-to-open's name
strFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls")
If strFilename = False Then Exit Sub ' to exit if Cancel button pressed

''''Open the desired Book
Workbooks.Open(strFilename)
''''Copy the sheet contents
Workbooks(strFilename).Sheets("Sheet1").Cells.Copy
''''Paste the contents
Workbooks(CurrentBook).Sheets("Sheet3").Cells.Paste
''''Close the newly opened book
Workbooks(strFilename).Close
End Sub


This procedure should work as written. I haven't tested it, so let me know if any errors occur.

In the next post, we will refine the procedure a bit and add some basic error handling

SamT
03-14-2013, 10:25 AM
Pototoj,

First we want to make the procedure a little easier to maintain. We will use Constants to hold the names of the Copy sheet and paste sheet, that way if this procedure gets very long and the names of those sheets ever change, we can adjust the procedure only once at the very top.

Sub Getopenfile()
Const CopySht As String = "Sheet1"
Const PasteSht As String = "sheet3"
Dim strFilename As String
Dim CurrentBook As String
CurrentBook = ThisWorkbook.Name

''''Get the book-to-open's name
strFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls")
If strFilename = False Then Exit Sub ' to exit if Cancel button pressed

''''Open the desired Book
Workbooks.Open(strFilename)
''''Copy the sheet contents
Workbooks(strFilename).Sheets(CopySht).Cells.Copy
''''Paste the contents
Workbooks(CurrentBook).Sheets(PasteSht).Cells.Paste
''''Close the newly opened book
Workbooks(strFilename).Close
End Sub
Note that now there are no hard-coded values in the Procedure body. This is always a good thing.

Any time a procedure is doing complex things to Excel, like opening workbooks for a short time, or pasting a lot of data, we want to keep the "visual noise" down and speed up our application.


'These prevent Excel from showing what ever is happening
Application.ScreenUpdating = False
Application. Display Alerts = False
.
.
.
'We need to be sure and turn them back on, or we won't be able to do anything else
'after the procedure runs.
Application.ScreenUpdating = True
Application. Display Alerts = True
Very basic Error handling is just to tell the user that something bad happened.


Dim ErrMsg As String
'The ErrMsg is always custom to the procedure
ErrMsg = "Something is Wrong" & _
Chr(13) & "Insure that the File to open has a Sheet1" & _
Chr(13) & "that this Workbook has a Sheet3."
'Chr(13) adds a new line

Dim ErrTitle As String 'ErrTile Holds the Caption of the error MsgBox
ErrTitle = "A Fatal Error Occurred"

Dim ErrButtons As Variant 'ErrButtons holds the Buttons to display in the Error MsgBox
ErrButtons = vbOKOnly + vbCritical

On Error Goto ErrHandling 'If an error occurs, skip everything until ErrHandling: label
.
.
.
Exit Sub 'If it worked ok, exit the sub before the Error Handler
ErrHandling: 'The Label
Dim X ' needed to use multiple items in a MsgBox. Not used otherwise
X = MsgBox(ErrMsg, ErrButtons, ErrTitle)
End Sub

I'll put it all together in the next post

SamT
03-14-2013, 10:33 AM
All the actual working parts are still the same as the last code in Post #5 above.

Sub Getopenfile()
Const CopySht As String = "Sheet1"
Const PasteSht As String = "sheet3"
Dim strFilename As String
Dim CurrentBook As String
CurrentBook = ThisWorkbook.Name

'The ErrMsg is always custom to the procedure
ErrMsg = "Something is Wrong" & _
Chr(13) & "Insure that the File to open has a Sheet1" & _
Chr(13) & "that this Workbook has a Sheet3."
'Chr(13) adds a new line

Dim ErrTitle As String 'ErrTile Holds the Caption of the error MsgBox
ErrTitle = "A Fatal Error Occurred"

Dim ErrButtons As Variant 'ErrButtons holds the Buttons to display in the Error MsgBox
ErrButtons = vbOKOnly + vbCritical

On Error Goto ErrHandling 'If an error occurs, skip everything until ErrHandling: label

Application.ScreenUpdating = False
Application. Display Alerts = False
''''Get the book-to-open's name
strFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls")
If strFilename = False Then Exit Sub ' to exit if Cancel button pressed

''''Open the desired Book
Workbooks.Open(strFilename)
''''Copy the sheet contents
Workbooks(strFilename).Sheets(CopySht).Cells.Copy
''''Paste the contents
Workbooks(CurrentBook).Sheets(PasteSht).Cells.Paste
''''Close the newly opened book
Workbooks(strFilename).Close

Application.ScreenUpdating = True
Application. Display Alerts = True
Exit Sub 'If it worked ok, exit the sub before the Error Handler
ErrHandling: 'The Label
Dim X ' needed to use multiple items in a MsgBox. Not used otherwise
X = MsgBox(ErrMsg, ErrButtons, ErrTitle)
End Sub

pototoj
03-14-2013, 10:55 AM
Hi Sam and thanks for the very learning procedure. I am beginner so its really good to get it from the start. So thanks for that.

I got and error in this, you said you have not tested.


Sub Getopenfile()
Dim strFilename As String
Dim CurrentBook As String
CurrentBook = ThisWorkbook.Name

''''Get the book-to-open's name
strFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls")
If strFilename = False Then Exit Sub ' to exit if Cancel button pressed

''''Open the desired Book
Workbooks.Open (strFilename)
''''Copy the sheet contents
Workbooks(strFilename).Sheets("Sheet1").Cells.Copy
''''Paste the contents
Workbooks(CurrentBook).Sheets("Sheet3").Cells.Paste
''''Close the newly opened book
Workbooks(strFilename).Close
End Sub



Its a runtime error13 in this line


If strFilename = False Then Exit Sub


And i also tested it when you put the code together. It gives me an error
The msg box a fatal error have accoured comes up. And i tried it on a new sheet. So there must be something wrong with this one.

In the real sheet i have to use it in. I dont want to include sheet1. I will use this for the buttons. But the other sheets i will use. So off course important to be able to select the sheet to copy to, after open the file from the openfiledialog.
'
Hope it can be done and thanks for now

Potj.

SamT
03-14-2013, 12:06 PM
On the Runtime error try using this line instead

If strFilename = "False" Then Exit Sub ' to exit if Cancel button pressed

This is the first line encountered and it sends to process to the error handler MsgBox, so using the correct "False" may clear all errors.

pototoj
03-14-2013, 02:34 PM
Hi Sam and thanks. It changed the error to some lines below.
Workbooks(strFilename).Sheets(1).Cells.Copy
Subskript out of range.
I open a workbook with both sheet1 and sheet3, so some must be wrong.
Maybe if you have time, you could try and attach a sample with your test codes. The other also make an error. So if you have time it would be nice

Thanks
Potj

SamT
03-14-2013, 02:49 PM
If you want to pass the Copy sht to the procedure when you call it, you just have to declare the argument to pass in the Procedure Declaration
Sub Getopenfile(PasteSht As String)

If you also want to pass the CopySht Argument, then
Sub Getopenfile(PasteSht As String, CopySht As String)

To call the Procedure

'First declare and set the variable to pass
Dim CopyThisSheet As String
CopyThisSheet = "Sheet1"
Dim PasteToThisSheet As String
CopyTothisSheet = "Sheet3"
Then Call the Procedure.
GetOpenFile(PasteToThisSheet)
or
GetOpenFile(PasteToTHisSheet, CopyThisSheet)
If you are passing more than one argument, be sure that they are passed in the correct order
You can aslo use argument names, and put the arguments in any order.
GetOpenFile CopySht:=CopyThisSheet, PasteSht:=PasteToThisSheet

Remember that you assign names to variables and their Scope is local to the Procedure that you assign them in, so you can use the same name in different procedures
Dim CopySht As String
CopySht = "Sheet1"
Dim PasteSht As String
PasteSht = "Sheet3"
GetOpenFile(PasteSht, CopySht)

I have only changed this to use the PasteSht Argument.
Sub Getopenfile(PasteSht As String) Const CopySht As String = "Sheet1" Dim strFilename As String Dim CurrentBook As String CurrentBook = ThisWorkbook.Name 'The ErrMsg is always custom to the procedure ErrMsg = "Something is Wrong" & _ Chr(13) & "Insure that the File to open has a Sheet1" & _ Chr(13) & "that this Workbook has a Sheet3." 'Chr(13) adds a new line Dim ErrTitle As String 'ErrTile Holds the Caption of the error MsgBox ErrTitle = "A Fatal Error Occurred" Dim ErrButtons As Variant 'ErrButtons holds the Buttons to display in the Error MsgBox ErrButtons = vbOKOnly + vbCritical On Error Goto ErrHandling 'If an error occurs, skip everything until ErrHandling: label Application.ScreenUpdating = False Application. Display Alerts = False ''''Get the book-to-open's name strFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls") If strFilename = False Then Exit Sub ' to exit if Cancel button pressed ''''Open the desired Book Workbooks.Open(strFilename) ''''Copy the sheet contents Workbooks(strFilename).Sheets(CopySht).Cells.Copy ''''Paste the contents Workbooks(CurrentBook).Sheets(PasteSht).Cells.Paste ''''Close the newly opened book Workbooks(strFilename).Close Application.ScreenUpdating = True Application. Display Alerts = True Exit Sub 'If it worked ok, exit the sub before the Error Handler ErrHandling: 'The Label Dim X ' needed to use multiple items in a MsgBox. Not used otherwise X = MsgBox(ErrMsg, ErrButtons, ErrTitle) End Sub
You can use a popup input dialog to get the sheet to save to.

SamT
03-14-2013, 02:56 PM
Hi Sam and thanks. It changed the error to some lines below.
Workbooks(strFilename).Sheets(1).Cells.Copy
Subskript out of range.

Sorry to be so long getting back to you, I had to go to town.

Where did Sheets(1) come from?

I did compile the code before I posted it and it compiled without error. That does not mean that it will run without error, just that there are no errors in syntax or declarations.

Before you reply, check out my previous post which goes farther in explaining what is happening.

pototoj
03-14-2013, 03:29 PM
HI Sam. Sorry i am maybe tired. But if you can please test if and post a sample. Sheet1 was from the sheet i opened, and it should copy to sheet 3 in the workbook i use the code in. If i understand it correct. So i am a littel confused. The code in the end where you put all together give me only the messagebox with the fatal error.
So please if you have time upload a sample.I think it will be more easy for me to understand if i can see some working there.

Thanks

Potj

SamT
03-14-2013, 04:04 PM
potJ,

I am sorry, I just noticed that the original post of this code wound up all on one line. This is the enire (almost) finished procedure. As soon as we kow it works, we will add some code so you can select the PasteSht.

Don't worry that it takes some experimenting to make things work, that is typical. We should have this done today if you just hang in there a bit longer


Sub Getopenfile()
Const PasteSht As String = "Sheet3"
Const CopySht As String = "Sheet1"
Dim strFilename As String
Dim CurrentBook As String
CurrentBook = ThisWorkbook.Name

'The ErrMsg is always custom to the procedure
ErrMsg = "Something is Wrong" & _
Chr(13) & "Insure that the File to open has a Sheet1" & _
Chr(13) & "that this Workbook has a Sheet3."
'Chr(13) adds a new line Dim ErrTitle As String

'ErrTitle Holds the Caption of the error MsgBox
ErrTitle = "A Fatal Error Occurred"

Dim ErrButtons As Variant 'ErrButtons holds the Buttons to display in the Error MsgBox
ErrButtons = vbOKOnly + vbCritical

On Error Goto ErrHandling 'If an error occurs, skip everything until ErrHandling: label
Application.ScreenUpdating = False
Application. Display Alerts = False

''''Get the book-to-open's name
strFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls")
If strFilename = "False" Then Exit Sub ' to exit if Cancel button pressed

''''Open the desired Book
Workbooks.Open(strFilename)
''''Copy the sheet contents
Workbooks(strFilename).Sheets(CopySht).Cells.Copy
''''Paste the contents
Workbooks(CurrentBook).Sheets(PasteSht).Cells.Paste
''''Close the newly opened book
Workbooks(strFilename).Close

Application.ScreenUpdating = True Application.
Display Alerts = True
Exit Sub 'If it worked ok, exit the sub before the Error Handler

ErrHandling: 'The Label
Application.ScreenUpdating = True 'maybe we had an error and skipped this above
Application. Display Alerts = True

Dim X ' needed to use multiple items in a MsgBox. Not used otherwise
X = MsgBox(ErrMsg, ErrButtons, ErrTitle)
End Sub

pototoj
03-14-2013, 09:52 PM
HI Sam and thanks. I think we have a heavy timedifference. Went to bed yesterday very late smile. I am from europe. smile

I tried the last code here. Still error. This time in the error handling. If i remove all error handling. I can open a file, but get an error after then in this line.


Workbooks(strFilename).Sheets(CopySht).Cells.Copy

Subscript out of range.

So still some way to go.

Thanks
Potj

SamT
03-15-2013, 12:40 AM
A Simple troubleshooting technique.

Replace this section of code

''''Open the desired Book
Workbooks.Open(strFilename)
''''Copy the sheet contents
Workbooks(strFilename).Sheets(CopySht).Cells.Copy
''''Paste the contents
Workbooks(CurrentBook).Sheets(PasteSht).Cells.Paste
''''Close the newly opened book
Workbooks(strFilename).Close

With this piece. Note the many Comment marks after each added line. This makes it easier to get them all out when done.
''''Open the desired Book
MsgBox("This is strFilename: " & strFilename) ''''''''''
Workbooks.Open(strFilename)
''''Copy the sheet contents
MsgBox("This is CopySht's name: " & CopySht.Name) ''''''''''
On Error MsgBox("Error in line Workbooks(strFilename).Sheets(CopySht)") ''''''''If next line errors out
Dim X As Object '''''''''''''
Set X = Workbooks(strFilename).Sheets(CopySht) ''''''''Try and get CopySht
Workbooks(strFilename).Sheets(CopySht).Cells.Copy
MsgBox("Hmm, No Error in line Workbooks(strFilename).Sheets(CopySht)") ''''''''''
''''Paste the contents
Workbooks(CurrentBook).Sheets(PasteSht).Cells.Paste
''''Close the newly opened book
Workbooks(strFilename).Close

pototoj
03-15-2013, 04:17 AM
HI Sam this was read when i pasted it in. Tried to move around, but not luck.
maybe better if you try in a sample, then you know if there come any errors.
Here is the error


On Error MsgBox("Error in line Workbooks(strFilename).Sheets(CopySht)") ''''''''If next line errors out


Thanks
Potj

jolivanes
03-15-2013, 12:15 PM
Sub Maybe_This()
Dim wba As Workbook, wbb As Workbook, strFilename As String
Set wba = ThisWorkbook
Application.ScreenUpdating = False
strFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls")
Workbooks.Open (strFilename)
Set wbb = Workbooks.Open(Filename:=strFilename)
wbb.Sheets("Sheet1").Range("A1:A10").Copy wba.Sheets("Sheet3").Range("A1") '<---- Change as required
wbb.Close
Application.ScreenUpdating = True
End Sub

SamT
03-15-2013, 05:24 PM
Do you mean that you saw a msgbox that said
"Error in line Workbooks(strFilename).Sheets(CopySht)"

jolivanes
03-15-2013, 09:55 PM
No, I just went by post #1.
Obviously, It might need to be changed to fit pototoj's precise needs like paste special, paste in a different range etc etc.

SamT
03-15-2013, 10:17 PM
Jolivanes,

Sorry, My question was for Potj

pototoj
03-16-2013, 12:09 AM
Hi Sam and Jolivanes. And thanks to both
Sam. No it didnt come up with this error message. This was just here the text indicated there was an error.

Hi Jolivanes. Your code is working fine. It does the job for sure. One question. When i open up another workbook, the only thing which can trigger this to be an error. Is if the sheet i open up, is not called Sheet1.

Is there any way to make this not so important. Or maybe put an inbox in, and ask for the sheet to copy.Maybe this was better in fact.
The range i copy. i put to Range("A:AR"). Is there another way. can this be written another way, if i want all cells to be copied, from the sheet i open up?

Thanks

jolivanes
03-16-2013, 12:55 PM
You could try this.

Sub Maybe_This_A()
Dim wba As Workbook, wbb As Workbook, strFilename As Variant, shnr As Variant
Set wba = ThisWorkbook
Application.ScreenUpdating = False
strFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls), *.xls")
If strFilename = False Then GoTo Cancel
Workbooks.Open (strFilename)
Set wbb = Workbooks.Open(Filename:=strFilename)
shnr = Application.InputBox("Enter Sheet No", , , , , , , 1)
shnr = Int(Val(shnr))
wbb.Sheets(shnr).Range("A1", wbb.Sheets(shnr).Range("A" & Rows.Count).End(xlUp).Offset(, 43)).Copy wba.Sheets("Sheet3").Range("A1")
wbb.Close
Application.ScreenUpdating = True
Exit Sub
Cancel:
MsgBox "You did not select a file!"
End Sub

pototoj
03-16-2013, 10:38 PM
Thanks Jolivanes.
This code works perfect. Can be practically with the inputbox, if the name is different. So thanks allot. Also thanks to Sam for the work, and tutorials.
Will mark this thread as solved.
Sincerely
Potj

SamT
03-16-2013, 10:56 PM
Jolivanes,

Good job.

:beerchug:

jolivanes
03-18-2013, 08:52 PM
pototoj.

I know it is solved but attached is a workbook that works with a userform.

Might be easier.

Try it

durgaprasadz
03-19-2013, 02:01 AM
Thanks for sharing information. Actually I had also the same question in mind for a long

time anyways you started this thread & I am so happy.

jolivanes
03-19-2013, 10:33 AM
pototoj/durgaprasadz
Change (or add the marked line) Code to following


Private Sub ListBox1_Click()
Sheets(ListBox1.Value).Activate
If WorksheetFunction.CountA(Cells) = 0 Then MsgBox ActiveSheet.Name & " is empty": Exit Sub '<--- Add this line
ActiveSheet.Range("A1").Resize(Cells.Find(what:="*", searchorder:=xlRows, _
searchdirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", searchorder:=xlByColumns, _
searchdirection:=xlPrevious, LookIn:=xlValues).Column).Copy wba.Sheets("Sheet3").Range("A1")
ActiveWorkbook.Close
Unload Me
End Sub


This is an error check in case you select an empty Sheet.
If there is a better way, I assume it will be posted.

pototoj
03-24-2013, 12:17 AM
Thanks for the sample file Jolivanes. Sorry for no answer. Have been out travelling for some time. But i just checked it and its great and as the other said, also me have been looking for this for some time. So thanks allot. Really great

Potj

SamT
03-24-2013, 02:07 AM
:thumb