Copy Worksheet to Workbook from mutliple files

[kaffal]

Hi all, I found some code to copy the worksheet from one workbook.

Currently I am able to copy the worksheet using hardcoded path from cell value,D3 and filename from cell value, D4.

However there is more than one worksheet to copy over in the directory.
I would like to program in a way that it will locate all the files with the filename contain cell value,D4 and do the copy of worksheet over, into a newly created worksheet named with the cell value, A1.

For example, the cell value,D4 is 06032009. In the directory, there are 10 files with 3 files contain the cell value (06032009_prod1.xls, 06032009_prod2.xls, 06032009_prod3.xls).

The macro will then create 3 new tabs with the content being copied over.

Sub CopyWorksheet()

    Sheets("Menu").Select
    PathName = Range("D3").Value
    FileName = Range("D4").Value

    ControlFile = ActiveWorkbook.Name
    Workbooks.Open FileName:=PathName & FileName
    TabName = Range("A1").Value
    ActiveSheet.Name = TabName
    Sheets(TabName).Copy After:=Workbooks(ControlFile).Sheets(1)
    Windows(FileName).Activate
    ActiveWorkbook.Close SaveChanges:=False
    Windows(ControlFile).Activate
    Sheets("Menu").Select
    Range("D8").Select
    ActiveCell.Value = "Completed"
    Range("D9").Select
End Sub

 

[shyrath]

Slightly different from what you ask. However.

This code will loop through the files in the specified folder, rename the sheet to the range starting in A2 ( the way you describe it would always be the same name? ). Or perhaps you mean using the sheetname?

Excel Workbook
	A	B	C	D
1	Tabname	Status
2	123			Fname
3	124			c:\temp\
4	125
5	126
6	127
7	128
8	129
9	130
10	131
11	132
12	133
13	134
14	135
15	136
16	137
17	138
18	139
19	140
20	141
menu

Sub RunCodeOnAllXLSFiles()

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook
i = 2

fpath = Sheets("menu").Range("D3")

    With Application.FileSearch
        .NewSearch
         'Change path to suit
        .LookIn = fpath
        .FileType = msoFileTypeExcelWorkbooks
        '.Filename = "Book*.xls"
    

            If .Execute > 0 Then 'Workbooks in folder

              For lCount = 1 To .FoundFiles.Count 'Loop through all.
                 'Open Workbook x and Set a Workbook variable to it
                 Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)


                 'DO YOUR CODE HERE
                      
                                  
                  tabname = wbCodeBook.Sheets("Menu").Cells(i, 1).Value
                  ActiveSheet.Name = tabname
                  ActiveSheet.Copy After:=wbCodeBook.Sheets(1)
                  i = i + 1
                                   
                  wbCodeBook.Sheets("Menu").Cells(i, 2).Value = "Completed"
                  wbResults.Close SaveChanges:=True
                 
                 Next lCount

            End If

    End With

    On Error GoTo 0


    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True



End Sub

 

[kaffal]

hi , It worked . However there remain one more problem.

        .FileName = "06032009*.xls"

Instead of changing inside the code itself, to define the search of "06032009".
Can I assign to a specific cell value,D4?

For example, If I enter 10032009 in cell,D4. It will find all the files name contain 10032009 instead of 06032009.

 

[westconn1]

.filename = range("d4") & "*.xls"

note application.filesearch is discontinued, vba Dir will also return the same files, with slightly different code

 

[kaffal]

Great it works, sorry I have one more problem.

I added one condition to satisty before it will be copied over to the workbook.
However I got one more problem, I noticed that macro will open up all files contain my search criteria. If the condition of cell value,B3 is not empty, it will copied over and the file is closed.
If the cell value is empty, the worksheet wun be copied over and it remain opened. How to close all up those open files even though the condition is not satisfied. How can i change the code to do that ?

Another off topic noob question, I understand that worksheets need to open in the macro, but i can see that files are opening and closing in the toolbars during the extraction. Is there any way to stop the opening and closing of files not seen by the users?

For lCount = 1 To .FoundFiles.Count 'Loop through all.
                 'Open Workbook x and Set a Workbook variable to it
                 Set wbResults = Workbooks.Open(FileName:=.FoundFiles(lCount), UpdateLinks:=0)


                 'DO YOUR CODE HERE
                  TabName = Range("A1").Value
                  EmptyCell = Range("B3").Value
                  If EmptyCell <> "" Then
                  ActiveSheet.Name = TabName
                                  
                  Sheets(TabName).Copy After:=wbCodeBook.Sheets(1)
                  i = i + 1
                                   
                  wbCodeBook.Sheets("Menu").Cells(i, 2).Value = "Completed"
                  
                  wbResults.Close SaveChanges:=True
                 End If
                 Next lCount

 

[westconn1]

move the wbresults.close line below the end if
if you don't want to save the file use a variable for savechanges, set to false when opening each file, then set to true within the if statement

for the display problem, you can try
application.screenupdating = false before the loop, reset to true when loop finishes
alternatively you can set the whole application to visible = false

 

[shyrath]

.filename = range("d4") & "*.xls"

note application.filesearch is discontinued, vba Dir will also return the same files, with slightly different code

Didn´t know that thx for the tip

 

[kaffal]

move the wbresults.close line below the end if
if you don't want to save the file use a variable for savechanges, set to false when opening each file, then set to true within the if statement

for the display problem, you can try
application.screenupdating = false before the loop, reset to true when loop finishes
alternatively you can set the whole application to visible = false

For the close file, it works.

However for the display problem, it does not works.
Any other advise ?