Loop not working for all files in the folder

ankit13

New Member
Joined
Aug 21, 2014
Messages
14
Hello...!!!

I have a problem with my following code

Code[]
Sub Combine() Dim Fpath As String, Fname As String

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

Fpath = "C:\Users\Final\" ' change to suit your directory
Fname = Dir(Fpath & "*.*")


With Workbooks("details.xlsx") 'MUST BE OPEN
Do While Fname <> ""
If Fname <> .Name Then
Workbooks.Open Fpath & Fname, 0
If Err.Number <> 0 Then
MsgBox ("Unable to open file " & Filename)
End If
On Error GoTo 0
Filename = Dir
'MOVE ONLY IF NOT SAVING ON CLOSE. IF SAVING, USE COPY.
Workbooks(Fname).Sheets("6.1").Copy After:=.Sheets(.Sheets.Count)
Workbooks(Fname).Close SaveChanges:=False
End If
Fname = Dir
Loop
End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
code[/]

this code loops in alternative workbook's sheets not all the workbooks of the specified folder...

I want it to loop in all the workbooks

Please help...
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
It's because you are calling the function "DIR" twice within your loop

Code:
Sub Combine() Dim Fpath As String, Fname As String

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

Fpath = "C:\Users\Final\" ' change to suit your directory
Fname = Dir(Fpath & "*.*")


With Workbooks("details.xlsx") 'MUST BE OPEN
Do While Fname <> ""
If Fname <> .Name Then
Workbooks.Open Fpath & Fname, 0
If Err.Number <> 0 Then
MsgBox ("Unable to open file " & Filename)
End If
On Error GoTo 0
Filename = Dir
'MOVE ONLY IF NOT SAVING ON CLOSE. IF SAVING, USE COPY.
Workbooks(Fname).Sheets("6.1").Copy After:=.Sheets(.Sheets.Count)
Workbooks(Fname).Close SaveChanges:=False
End If
Fname = Filename
Loop
End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub


I have changed Fnaem =DIR to Fname = Filename
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,988
Members
448,538
Latest member
alex78

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