how make this code more dynamically (loop all files in the same directory )

abdelfattah

Well-known Member
Joined
May 3, 2019
Messages
1,429
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
hi experts

I have this code import specific sheet to closed file . now I have many files in the same directory what I want import specific sheets ( sh1,imp, ex ,ret) from multiple files in the same directory . it should search for theses sheets in all files and import the data to closed file.
any suggestion to do that,please?



VBA Code:
Sub CopySheetToClosedWB()
Dim SourceSht As Worksheet
Set SourceSht = Sheets("sheet2")
Application.ScreenUpdating = False
Set closedBook = Workbooks.Open("C:\Users\PC WORLD\Desktop\sub1.xlsm")
SourceSht.Copy After:=closedBook.Sheets("rs")
closedBook.Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub
 
  • Like
Reactions: JEC

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
This is not tested but you will get the idea. Since you are running the code from sub1.xlsm, then I just use
Set ClosedBook = ActiveWorkbook
instead of
Set closedBook = Workbooks.Open("C:\Users\PC WORLD\Desktop\sub1.xlsm")

VBA Code:
Sub CopySheetToClosedWB()

Dim FPath As String, ArryName() As String
Dim FName As Variant, wsName As Variant
Dim ws As Worksheet, SourceSht As Worksheet
Dim wb As Workbook, ClosedBook As Workbook

FPath = "C:\Users\PC WORLD\Desktop\"
FName = Dir(FPath)

Set ClosedBook = ActiveWorkbook
Set SourceSht = ClosedBook.Sheets("Sheet2")

Application.ScreenUpdating = False

ArryName = Split("sh1,imp,ex,ret", ",")
While FName <> ""
    If Not FName = ClosedBook.Name Then
        Set wb = Workbooks.Open(Filename:=FPath & FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
        For Each wsName In ArryName
            Set ws = wb.Sheets(wsName)
            ws.Copy After:=ClosedBook.Sheets("rs")
        Next
    End If
    'Close wb without saving
    wb.Close False
    'Set the fileName to the next file
    FName = Dir
Wend
ClosedBook.Close True

End Sub
 
Upvote 0
thanks but every time shows different error. sorry but this is my mistake I don't explain clearly . what I want the code should be in closed file and when open it should import all the sheets from all files in the same directory .
 
Upvote 0
thanks but every time shows different error. sorry but this is my mistake I don't explain clearly . what I want the code should be in closed file and when open it should import all the sheets from all files in the same directory .
I was just merely copy your code with slight change of variable. :unsure:

I see what the problem is now.

You are importing specific sheets ( sh1,imp, ex ,ret) from each files into ClosedWorkbook, right? I presumed you have empty sheets with similar name in ClosedWorkbook. You will be copying same named sheet from each files into matching sheets in ClosedWorkbook. That is how it seems to me.

Please clarify what is your intention there.
 
Upvote 0
Never mind my previous comment. I was wrong.

Here is the amended code. It loop to find those specific sheet unlike the previous code which will give error if sheet name was not found.

VBA Code:
Sub CopySheetToClosedWB()

Dim FPath As String, ArryName() As String
Dim FName As Variant, wsName As Variant
Dim ws As Worksheet, SourceSht As Worksheet
Dim wb As Workbook, ClosedBook As Workbook

FPath = "C:\Users\PC WORLD\Desktop\"
FName = Dir(FPath)

Set ClosedBook = ActiveWorkbook
Set SourceSht = ClosedBook.Sheets("rs")

Application.ScreenUpdating = False

ArryName = Split("sh1,imp,ex,ret", ",")
While FName <> ""
    If Not FName = ClosedBook.Name Then
        Set wb = Workbooks.Open(Filename:=FPath & FName, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
        For Each ws In wb.Sheets
            For Each wsName In ArryName
                If wsName = ws.Name Then
                    Set ws = wb.Sheets(ws.Name)
                    ws.Copy After:=ClosedBook.Sheets("rs")
                End If
            Next
        Next
        'Close wb without saving
        wb.Close False
    End If
    'Set the fileName to the next file
    FName = Dir
Wend
ClosedBook.Close True

End Sub
 
Upvote 0
perfect ! but I have a problem . I put the code in workbook open event .when I open the file should update the sheets automatically . so when open file every time will creat the sheets again sh1(1),imp(1),ex(1) I don't want so. when open the file just updating the sheets are existed . if change data in others files also should update in my file when open every time without create sheets again when open file continouisly . just update the data .

thanks again
 
Upvote 0
perfect ! but I have a problem . I put the code in workbook open event .when I open the file should update the sheets automatically . so when open file every time will creat the sheets again sh1(1),imp(1),ex(1) I don't want so. when open the file just updating the sheets are existed . if change data in others files also should update in my file when open every time without create sheets again when open file continouisly . just update the data .

thanks again
This is the part I need to ask actually. Since every file your are copying has sheets with same name, it will create sheets with same file names again and again with number increment in suffix to differentiate.

You original code call for whole sheet copy including sheet names. I don't understand what you meant by updating. is it replacing whole sheet or only certain range?
 
Upvote 0
replacing whole sheet .
thanks again
You are looping many files in the same folder with similar sheet names over and over again. This means you are replacing and replacing sheets over and over again until finish looping all the files? :unsure:o_O
 
Upvote 0
If you want to avoid duplicating sheets differentiated just by suffix, then just delete the sheets and then copy.
 
Upvote 0

Forum statistics

Threads
1,214,985
Messages
6,122,606
Members
449,089
Latest member
Motoracer88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top