Solved

Copy first worksheet of several source files to a target file using VBA

Posted on 2013-12-10
25
466 Views
Last Modified: 2013-12-15
Dear Experts:

below code ...
... prompts the user to select a (1) source file
... the first worksheet of this source file is copied to the target file at the very beginning
... if a worksheet name in the target file matches the copied worksheet name in the source file, a MsgBox says so and the macro exits.

Could somebody help me re-write this code ...
so that the user is able to select several excel-files in the open file dialog box (from 2 to n, usually between 2 and up to 10 are selected) and ...
the first worksheet of each selected source file is then copied to the target file (currently active workbook) at the very beginning.  
if a worksheet name in the target file matches one of the copied worksheet names in the source file, a MsgBox says so and the macro exits.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Private Sub Import_Data_Into_Current_Workbook_EE()

Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook

' active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook

With Application.fileDialog(msoFileDialogOpen)

    .ButtonName = "&Open"
    .InitialFileName = "C:\MyFile\Data"
    .Filters.Clear
    .Filters.Add "Excel files (*.xls; *.xlsm; *.xlsx)", "*.xls;*.xlsm;*.xlsx", 1
    .Title = "Please Select an input file"
    .AllowMultiSelect = False
End With

  If Not (Application.fileDialog(msoFileDialogOpen).Show) Then
     MsgBox "No File specified!.", vbExclamation, "Cancel has been pressed!"
     Exit Sub
  Else
     customerFilename = Application.fileDialog(msoFileDialogOpen).SelectedItems(1)

Set customerWorkbook = Application.Workbooks.Open(customerFilename)


Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)

On Error Resume Next
Set srcSht = targetWorkbook.Sheets(sourceSheet.Name)
On Error GoTo 0
    If IsEmpty(srcSht) Then
    sourceSheet.Copy Before:=targetWorkbook.Sheets(1)
    Else
        MsgBox "Sheet name already there"
        Exit Sub

    End If
End If

customerWorkbook.Close

End Sub

Open in new window

0
Comment
Question by:AndreasHermle
  • 11
  • 8
  • 6
25 Comments
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
Comment Utility
Try

Private Sub Import_Data_Into_Current_Workbook_EE()
Dim fn As Variant
Dim customerFilename As Variant
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
customerFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True)
' active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook

Dim sourceSheet As Worksheet
For Each fn In customerFilename
    Set customerWorkbook = Workbooks.Open(fn)
    Set sourceSheet = customerWorkbook.Worksheets(1)
   
    On Error Resume Next
    Set srcSht = targetWorkbook.Sheets(sourceSheet.Name)
    On Error GoTo 0
        If IsEmpty(srcSht) Then
        sourceSheet.Copy Before:=targetWorkbook.Sheets(1)
        customerWorkbook.Close
        End If
Next fn
End Sub
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
There is a redundancy in what you say:

you said:
•the first worksheet of each selected source file is then copied to the target file (currently active workbook) at the very beginning.  

Then you say:
•if a worksheet name in the target file matches one of the copied worksheet names in the source file, a MsgBox says so and the macro exits.

I have the following case:
Present active workbook has Sheet1, Sheet2, Sheet3

You select 5 files from Excel if I go about your first point, then we should copy to the current workbook all the first sheets found in the 5 workbooks .. Then
we go to the second point and if the same worksheet exist already then give a message and Exit.

What if all the 5 files have the first sheet being Sheet1 ??? then you macro will never copy any file ? is that what you want ? or you wanted to copy all the Sheets and rename them ???

Not clear.
As when I run it it will never copy any sheet unless this sheet NEVER exist in the workbook is that what you want ?

Also you want the program to halt when it find the same sheet but if you have a selection of 5 workbooks then it will exit on the first one and never continue to all of them.

gowflow
0
 

Author Comment

by:AndreasHermle
Comment Utility
Hi gowflow,

this forum is just great.

... that is indeed a very good point you are making. Thank you very, very much to bring this to my attention. Of course you are right!

Actually, what I would like to have is the following:

If a sheet to be pasted in the target file already exists (such as sheet 1), the macro is to rename it to 'sheet 1(2)'. So I might end up - based on the case you describe above - with sheet 1(2), sheet 1(3), sheet 1 (4) etc. But that would be fine, as long as the macro tells me at the end that there were 'n' occurrences of sheets that had the same name (if this is possible.

Hi ssaqibh:
Your code works great but only in cases where each first sheet of the selected source files is named differently, if they are named 'sheet 1' in all of the files, the 'sheet 1' in the target file gets overwritten several times ie. I end up with just one 'sheet 1'

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
0
 
LVL 43

Assisted Solution

by:Saqib Husain, Syed
Saqib Husain, Syed earned 120 total points
Comment Utility
The code you provided was from Rgonzo...
In the same question the code provided by me is probably more appropriate for this requirement of yours.

I have modified the code but not tested. Please come back if there is some problem.

Private Sub Import_Data_Into_Current_Workbook_EE()
Dim fn As Variant
Dim customerFilename As Variant
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
customerFilename = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*), *.xls*", MultiSelect:=True)
' active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook

Dim sourceSheet As Worksheet
For Each fn In customerFilename
    Set customerWorkbook = Workbooks.Open(fn)
    Set sourceSheet = customerWorkbook.Worksheets(1)
        sourceSheet.Copy before:=targetWorkbook.Sheets(1)
        customerWorkbook.Close
Next fn
End Sub
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
Andreas,

I finally got it as you may have several possibilities here the one I mentioned above was one and there is more there are some workbook that may contain macros, and when you import that sheet last thing you want is to have the macro in the new workbook being activated.

So try this version, I posted a full workbook that contain the code and 1 button in Sheet1 it is all self explanatory you will get a prompt that will tell you what will happen.

Make sure your macros are activated and press the button in sheet1.

Let me know. We can cater to your desire the naming of new sheets.

Rgds/gowflow
ImportFirstSheetOfSelectedWB.xls
0
 

Author Comment

by:AndreasHermle
Comment Utility
Hi gowflow,

thank you very much for the time taken and your professional help. But I am afraid to tell you that nothing happens with the exception that the MsgBox shows the amount of worksheets copied, but actually nothing is copied at all. Any idea why?

Thank you very much

Regards, Andreas
0
 

Author Comment

by:AndreasHermle
Comment Utility
Hi gowflow,

forget what I just wrote. All of the source worksheets to be imported had merged cells as column headers and this prevented excel to copy and paste the stuff correctly. After unmerging all these cells, everything runs just fine. I will do more testing and then let you know.

Again, thank you very much for your great help.

Regards, ANdreas
0
 

Author Comment

by:AndreasHermle
Comment Utility
Hi gowflow,

there is one small thing, I guess, which should be adressed:

If the user presses Cancel on the Open File Dialog Box the macro is to exit. Now it runs into the debug mode. Thank you very much in advance.

Regards, Andreas
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
good glad to know that. Before I got to this version trust me it was not easy I had some copied some no some the macro started (of the book we are copying) some gave errors ... so I am not surprised that it still need fine tuning.

Pls do not try to cater for the macro the macro should cater to you. So report all the incident that did not work and I will make sure if possible to handle all cases.

gowflow
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
ok our posts just crossed I will make sure the Cancel issue is corrected. Will need all the amendments so we work efficiently.
gowflow
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
I have reviewed the whole macro and cleaned the unnecessary instructions and cleaned it up all together and addressed the sorting of sheets as well as the cancel issue.

Please chk this version and lets build on this one.

btw it has only 1 sheet called Main.
gowflow
ImportFirstSheetOfSelectedWB-V01.xls
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
Comment Utility
Hi, did you try my last post?
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:AndreasHermle
Comment Utility
Hi ssaqibh,

sorry for the delay, yes I tried it and after unmerging cells in the source sheets it works just fine, too. If you could incorporate the following requirement, it would be great:

- if a worksheet name in the target file matches one of the copied worksheet names in the source file, a duplicate file is created in the target file (as with gowflow's macro). This way I had two macro approaches with a similar outcome.

Thank you very much. Regards, Andreas
0
 

Author Comment

by:AndreasHermle
Comment Utility
Hi gowflow,

that is very kind of you. I will give it a try soon and then let you know. I really appreciate your efforts.

Regards, Andreas
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
Comment Utility
That is what my last code is supposed to do. What else is it doing?
0
 

Author Comment

by:AndreasHermle
Comment Utility
Hi ssaqibh,

it is running just fine with the exception that no duplicate files are generated should source files have the same name as the target files. I will do some more testing and then let you know.

Regards, Andreas
0
 

Author Comment

by:AndreasHermle
Comment Utility
Hi gowflow, ssaqibh,

it will be Saturday and Sunday for my testing.

Regards, Andreas
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
No problem hv a good weekend
gowflow
0
 

Author Comment

by:AndreasHermle
Comment Utility
Hi gowflow,

great, works just fine. There is one small thing. I would like the open dialog box to point to C:\MyFile\Data (hard coded) every time it is opened up.

Otherwise everything is fine. Great job. Thank you very much.

Regards, Andreas
0
 

Author Comment

by:AndreasHermle
Comment Utility
Hi ssaqibh.

I tried your last code. What I wrote about your last code: I was mistaken, everything is fine.

if a worksheet name in the target file matches one of the copied worksheet names in the source file, a duplicate file is created in the target file (a number, e.g. (2) is appended).

There is one small thing. Could you please see to it, that the File Open Dialog Box points to C:\MyFile\Data everytime this dialog box is activated (hard coded).

So everything is fine. Thank  you very much for your great help.

Regards, Andreas
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
Comment Utility
Insert

Chdir "C:\MyFile\Data"

before the getopenfilename line.
0
 
LVL 29

Accepted Solution

by:
gowflow earned 380 total points
Comment Utility
Here it is with default opening "C:\MyFile\Data"
gowflow
ImportFirstSheetOfSelectedWB-V02.xls
0
 

Author Closing Comment

by:AndreasHermle
Comment Utility
Dear both,

it is always very hard to award points equitably, since both of you provided great working code and were very quick to answer.

thank you both for your great help and perfect support. I really appreciate it .

Regards, Andreas
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
Comment Utility
Never mind the points. Just keep the questions coming.
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
Exactly ! our pleasure to be able to help.
gowflow
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

7 Experts available now in Live!

Get 1:1 Help Now