VBA to open all files in a folder, put the file's name in a cell and copy it to another opened workbook

[feni1388]

Hello....

I have found a VBA code in mrexcel from previous years before in regard to opening all files in a certain folder.
Below are the code and I modified it a bit.
The VBA below is supposed to go open a file in a certain folder. Copy it to another opened workbook, go to another sheet in that workbook and print it out.
Next go to the next file in that folder and repeat the task.

The thing is that I also need to put the file name that I just opened in cell W2 so that I can copy it together to the workbook that I opened already.
I don't know how the VBA command for that. Can anyone help?
It would be nice too if I can add the command to close the file after finished copying it.

Sub AllFiles()

Dim folderPath As String
Dim filename As String
Dim wb As Workbook

folderPath = "\\obc\Share\【Dept】\customer\" 'change to suit

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.xls")
Do While filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & filename)

'Call a subroutine here to operate on the just-opened workbook --> (I don't know how to create a subroutine so I just put the command directly in it.)

Columns("A:W").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Sheet1").Select
Columns("A:W").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Print").Select

ActiveSheet.PrintOut

filename = Dir
Loop
Application.ScreenUpdating = True

End Sub

 

[JerrExcel]

Hi feni1388,

• I assume you need the filename in Sheet "Print".Range("W2"), so to print it out.
• Put "wb.close" inside the loop to close file.
• Does it really need to be copying Range(A:W) everytime? I would suggest counting the last row of usedrange, and just take that range, to make macro work faster.
• Put "Option Explicit" on top of your module to easily debug.
• Use Msgbox in the end to let user know the macro ended.

Please try this:

Option Explicit

Sub AllFiles()

Dim folderPath As String
Dim filename As String
Dim wb As Workbook
Dim data_lastrow As Long

folderPath = "\\obc\Share\【Dept】\customer\" 'change to suit

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.xls")

Application.ScreenUpdating = False

Do While filename <> ""

Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

ThisWorkbook.Sheets("Sheet1").Range("A:W").Clear

Set wb = Workbooks.Open(folderPath & filename)
data_lastrow = wb.Sheets(1).UsedRange.End(xlUp).Row
'Call a subroutine here to operate on the just-opened workbook --> (I don't know how to create a subroutine so I just put the command directly in it.)

ThisWorkbook.Sheets("Sheet1").Range("A1:W" & data_lastrow).Value = wb.Sheets(1).Range("A1:W" & data_lastrow).Value
ThisWorkbook.Sheets("Print").Range("W2").Value = wb.Name

ThisWorkbook.Sheets("Print").Activate
ThisWorkbook.Sheets("Print").UsedRange.PrintOut

wb.Close SaveChanges:=False

Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

filename = Dir
Loop
Application.ScreenUpdating = True

MsgBox "Print done"

End Sub

 

[feni1388]

Hi feni1388,

• I assume you need the filename in Sheet "Print".Range("W2"), so to print it out.
• Put "wb.close" inside the loop to close file.
• Does it really need to be copying Range(A:W) everytime? I would suggest counting the last row of usedrange, and just take that range, to make macro work faster.
• Put "Option Explicit" on top of your module to easily debug.
• Use Msgbox in the end to let user know the macro ended.

Please try this:

Option Explicit

Sub AllFiles()

Dim folderPath As String
Dim filename As String
Dim wb As Workbook
Dim data_lastrow As Long

folderPath = "\\obc\Share\【Dept】\customer\" 'change to suit

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.xls")

Application.ScreenUpdating = False

Do While filename <> ""

Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

ThisWorkbook.Sheets("Sheet1").Range("A:W").Clear

Set wb = Workbooks.Open(folderPath & filename)
data_lastrow = wb.Sheets(1).UsedRange.End(xlUp).Row
'Call a subroutine here to operate on the just-opened workbook --> (I don't know how to create a subroutine so I just put the command directly in it.)

ThisWorkbook.Sheets("Sheet1").Range("A1:W" & data_lastrow).Value = wb.Sheets(1).Range("A1:W" & data_lastrow).Value
ThisWorkbook.Sheets("Print").Range("W2").Value = wb.Name

ThisWorkbook.Sheets("Print").Activate
ThisWorkbook.Sheets("Print").UsedRange.PrintOut

wb.Close SaveChanges:=False

Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

filename = Dir
Loop
Application.ScreenUpdating = True

MsgBox "Print done"

End Sub

Thank you for your suggestion.
I copy the the whole column (A:W) just to make sure that there's no record is missing.

Btw, I also need to add SUM in column J of sheet "Print"

Set SumRg = .Range("J2", .Range("J" & Rows.Count).End(xlUp))
.Range("J" & Rows.Count).End(xlUp).Offset(1, 0) = "=Sum(" & SumRg.Address & ")"

But the above code doesn't seem to work and I don't what the problem is.
The length of J column varies. It can be only one row, or 2 or more.

can you please help?
Thank you.

 

[feni1388]

Thank you for your suggestion.
I copy the the whole column (A:W) just to make sure that there's no record is missing.

Btw, I also need to add SUM in column J of sheet "Print"

Set SumRg = .Range("J2", .Range("J" & Rows.Count).End(xlUp))
.Range("J" & Rows.Count).End(xlUp).Offset(1, 0) = "=Sum(" & SumRg.Address & ")"

But the above code doesn't seem to work and I don't what the problem is.
The length of J column varies. It can be only one row, or 2 or more.

can you please help?
Thank you.

PS: The sheet "Print" has links to sheet "Sheet1".
So I need sum formula that can be added at the last row of column J ignoring the links (some formula doesn't ignore the links and so add it where the links ends)

 

[JerrExcel]

Hi,

Please try

Dim LastRow As Long
LastRow = Sheets("Print").Cells(Cells.Rows.Count, "J").End(xlUp).Row + 1
Sheets("Print").Range("J" & LastRow).Formula = "=SUM(J2:J" & LastRow - 1 & ")"

But I don't think you can put this in the same macro. Because it will create more SUM as you run it routinely. (SUM below previous SUM)
Can I know any formula that you put in column J? or what will be changing when Sheets("Sheet1") is changing?

Thanks.

 

[feni1388]

Thank you. I added your formula to Sheet1 instead of sheet Print.

PS: I make sure that that it won't be SUM below previous SUM.
I just tried it and it works perfectly. Thank you.