Copying to Multiple Sheets in folder from one open sheet

[gunjan8882]

Dear all.

I am getting error for the following macro for copying and pasting data to multiple sheets in the folder. It seems after saving the file, clipboard gets clear and the copy text from the file gets unselected. Hence, the copy/paste function works for the first file and gives error for the subsequent files. Kindly help to correct the code. Thanks in advance.

-----------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()Dim oFSO
Dim Folder As Object
Dim Files As Object
Dim file As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set Folder = oFSO.GetFolder("J:\Flare Scenarios")
Workbooks("Page No.xlsm").Activate
ActiveSheet.Range("R2:V7").Select
Application.CutCopyMode = True
Selection.Copy
For Each file In Folder.Files
If file.Type Like "*Microsoft Excel*" Then
Workbooks.Open Filename:=file.Path
ActiveSheet.Range("C155").Select
ActiveSheet.Paste
Sheets("Module (LT)").Select
ActiveSheet.Range("C155").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=True
End If
Next file
Set oFSO = Nothing
End Sub
---------------------------------------------------------------------------------------------------------------------

 

[jmacleary]

Hi there.

Amend your code to move the CutCopyMode = False line to after the Next file line so you will then have:

Private Sub CommandButton1_Click()Dim oFSO
Dim Folder As Object
Dim Files As Object
Dim file As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set Folder = oFSO.GetFolder("J:\Flare Scenarios")
Workbooks("Page No.xlsm").Activate
ActiveSheet.Range("R2:V7").Select
Application.CutCopyMode = True
Selection.Copy
For Each file In Folder.Files
If file.Type Like "*Microsoft Excel*" Then
Workbooks.Open Filename:=file.Path
ActiveSheet.Range("C155").Select
ActiveSheet.Paste
Sheets("Module (LT)").Select
ActiveSheet.Range("C155").Select
ActiveSheet.Paste
ActiveWorkbook.Close SaveChanges:=True
End If
Next file
Application.CutCopyMode = False
Set oFSO = Nothing
End Sub

 

[gunjan8882]

Dear Jmacleary,

Thank you very much for your reply. It works