Excel to be closed Automatically after running Macro

L

laravindh

New Member
Joined
Aug 25, 2018
Messages
8
I am very new to creating excel Macro.
​
Please suggest me how to save and close the excel after running macro. I am using this VBA macro for concatenate more than 70 + excel files. It is difficult to save and close such big number of files at one time.
It would me grateful if you could provide me a solution.



Sub LoopThroughFiles()
FolderName = "C:\Users\Aravindh sandhya .LAPTOP-E6MTP0NR\Desktop\CONCATENATE VB\CONCATENATE"
If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
Fname = Dir(FolderName & "*.xls")
'loop through the files
Do While Len(Fname)
With Workbooks.Open(FolderName & Fname)
Dim LastRow As Long
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Range("H1:H" & LastRow) = Evaluate(Replace("D1:D#&"" , ""&E1:E#&"" , ""&F1:F#&"", ""&G1:G#", "#", LastRow))
LastRow = Cells(Rows.Count, "M").End(xlUp).Row
Range("O1:O" & LastRow) = Evaluate(Replace("M1:M#&"" OF ""&N1:N#", "#", LastRow))
End With
' go to the next file in the folder
Fname = Dir
Loop

End Sub
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
Code: 
[color=darkblue]Sub[/color] LoopThroughFiles()
    FolderName = "C:\Users\Aravindh sandhya .LAPTOP-E6MTP0NR\Desktop\CONCATENATE VB\CONCATENATE"
    [color=darkblue]If[/color] Right(FolderName, 1) <> Application.PathSeparator [color=darkblue]Then[/color] FolderName = FolderName & Application.PathSeparator
    Fname = Dir(FolderName & "*.xls")
    [color=green]'loop through the files[/color]
    [color=darkblue]Do[/color] [color=darkblue]While[/color] Len(Fname)
        [color=darkblue]With[/color] Workbooks.Open(FolderName & Fname)
            [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
            LastRow = Cells(Rows.Count, "D").End(xlUp).Row
            Range("H1:H" & LastRow) = Evaluate(Replace("D1:D#&"" , ""&E1:E#&"" , ""&F1:F#&"", ""&G1:G#", "#", LastRow))
            LastRow = Cells(Rows.Count, "M").End(xlUp).Row
            Range("O1:O" & LastRow) = Evaluate(Replace("M1:M#&"" OF ""&N1:N#", "#", LastRow))
[B]            .Close SaveChanges:=[color=darkblue]True[/color][/B]
        [color=darkblue]End[/color] [color=darkblue]With[/color]
        [color=green]' go to the next file in the folder[/color]
        Fname = Dir
    [color=darkblue]Loop[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
AlphaFrog said:
Code: 
[COLOR=darkblue]Sub[/COLOR] LoopThroughFiles()
    FolderName = "C:\Users\Aravindh sandhya .LAPTOP-E6MTP0NR\Desktop\CONCATENATE VB\CONCATENATE"
    [COLOR=darkblue]If[/COLOR] Right(FolderName, 1) <> Application.PathSeparator [COLOR=darkblue]Then[/COLOR] FolderName = FolderName & Application.PathSeparator
    Fname = Dir(FolderName & "*.xls")
    [COLOR=green]'loop through the files[/COLOR]
    [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] Len(Fname)
        [COLOR=darkblue]With[/COLOR] Workbooks.Open(FolderName & Fname)
            [COLOR=darkblue]Dim[/COLOR] LastRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
            LastRow = Cells(Rows.Count, "D").End(xlUp).Row
            Range("H1:H" & LastRow) = Evaluate(Replace("D1:D#&"" , ""&E1:E#&"" , ""&F1:F#&"", ""&G1:G#", "#", LastRow))
            LastRow = Cells(Rows.Count, "M").End(xlUp).Row
            Range("O1:O" & LastRow) = Evaluate(Replace("M1:M#&"" OF ""&N1:N#", "#", LastRow))
[B]            .Close SaveChanges:=[COLOR=darkblue]True[/COLOR][/B]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        [COLOR=green]' go to the next file in the folder[/COLOR]
        Fname = Dir
    [COLOR=darkblue]Loop[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Click to expand...


Thanks a lot!
 
Upvote 0
AlphaFrog said:
Code: 
[COLOR=darkblue]Sub[/COLOR] LoopThroughFiles()
    FolderName = "C:\Users\Aravindh sandhya .LAPTOP-E6MTP0NR\Desktop\CONCATENATE VB\CONCATENATE"
    [COLOR=darkblue]If[/COLOR] Right(FolderName, 1) <> Application.PathSeparator [COLOR=darkblue]Then[/COLOR] FolderName = FolderName & Application.PathSeparator
    Fname = Dir(FolderName & "*.xls")
    [COLOR=green]'loop through the files[/COLOR]
    [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] Len(Fname)
        [COLOR=darkblue]With[/COLOR] Workbooks.Open(FolderName & Fname)
            [COLOR=darkblue]Dim[/COLOR] LastRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
            LastRow = Cells(Rows.Count, "D").End(xlUp).Row
            Range("H1:H" & LastRow) = Evaluate(Replace("D1:D#&"" , ""&E1:E#&"" , ""&F1:F#&"", ""&G1:G#", "#", LastRow))
            LastRow = Cells(Rows.Count, "M").End(xlUp).Row
            Range("O1:O" & LastRow) = Evaluate(Replace("M1:M#&"" OF ""&N1:N#", "#", LastRow))
[B]            .Close SaveChanges:=[COLOR=darkblue]True[/COLOR][/B]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        [COLOR=green]' go to the next file in the folder[/COLOR]
        Fname = Dir
    [COLOR=darkblue]Loop[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Click to expand...

Is this possible make this script to work based on string value instead of range ie.I am concatenating column D,E,F,G and column M, N , instead of that is it possible to concatenate using the string values which is TITLE_1,
TITLE_2,
TITLE_3,LOCATION and concatenate by seeing SHEET_NO and TOTAL_SHEE. Output shall be placed in column BQ and BR respectively.
When concatenating ​
SHEET_NO and TOTAL_SHEE I need in format example 0001 OF 0046.

Thanks for your support.

BR
Aravindh​
 
Upvote 0
AlphaFrog said:
Probably, but I don't follow what your asking.
Click to expand...
sorry ..since I am not able to add snaps its hard to understand what I am asking.

Kindly help me out only in this query, using the below syntax I am joining two rows in the format eg: " 001 OF 046" but I need to add prefix in left side and right side so that my output will look like " 0001 OF 0046".Kindly suggest me some modification in the script to make this to work.

Range("O1:O" & LastRow) = Evaluate(Replace("M1:M#&"" OF ""&N1:N#", "#", LastRow))
​
 
Upvote 0
Code: 
Range("O1:O" & LastRow) = Evaluate("""0""&M1:M" & LastRow & "&"" OF 0""&N1:N" & LastRow)
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Set value for range being copied over with VBA
2
Replies
14
Views
724
ItalianPlatinum
I
G
  • Solved
Change Macro to import files from hyperlinks
2
Replies
12
Views
938
GarnesGambit
G
Y
  • Question Question
Modify Macro to Select 1 .TXT File at a time, do changes on it (tab delimeter+column to text) to convert to .XLS file+save the file then select other
Replies
0
Views
508
yferrer
Y
M
  • Question Question
Copy File Names to Destination File
Replies
2
Views
316
metalscuba
M
C
  • Question Question
How to automatically paste the data from one sheet to another using VBA
Replies
4
Views
235
Alex Blakenburg
A

Forum statistics

Threads
1,223,891
Messages
6,175,229
Members
452,621
Latest member
Laura_PinksBTHFT

Share this page

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