Run a macro on several Workbooks

Amy2011

New Member
Joined
Sep 15, 2011
Messages
14
Hi,

I am trying to run a macro on several different workbooks that don't have consistent filenames.

I have a master folder

H:\SubjectData\

which then has a subject folder
AO223\

which then contains 4 spreadsheets.

I have been able to do this before by typing in the path and filename into the spreadsheet, but I have 25 subject folders (so25*4 spreadsheets) in total that i want to run the macro over so trying to avoid having to type in each workbook filename!

Any help is much appreciated (trying to do things way above my VBA skill level!!)
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
If you list the subject folders in column A of sheet1:

AO223
AO234
AO331
...etc

Then you can loop through all those folders. Here's an outline to get you started.

Code:
Option Explicit

Sub ProcessAllFilesInSubjectFolders()
Dim MyPath As String, fName As String
Dim wbOPEN As Workbook
Dim MySubjects As Range, Subj As Range

MyPath = "H:\SubjectData\"
Set MySubjects = ThisWorkbook.Sheets("Sheet1") _
               .Range("A:A").SpecialCells(xlConstants)

For Each Subj In MySubjects
    fName = Dir(MyPath & Subj & "\*.xls")   'get first filename for this folder
    
    Do While Len(fName) > 0                 'process each file one at a time
        
        Set wbOPEN = Workbooks.Open(MyPath & Subj & fName)
        With wbOPEN
            
            'put your action code in here

            .Close True    'closes and saves, change to FALSE to not save changes
        End With
        
        fName = Dir         'get next filename
    Loop
Next Subj

End Sub
 
Upvote 0
I think this will work perfectly,

but I am getting an error (I think it's with my code that I have to insert)

In that code i am asking it to copy a range of cells from sheet one and paste into sheet2 (but in some of the workbooks sheet2 does not yet exist)

This is the part that i currently have:
Range("A1:ACF2").Select
Selection.Copy
Sheets("Sheet1").Activate
Cells(1, 1).Select
ActiveSheet.Paste

But i need to copy that range and paste it into a new worksheet (within that workbook)

Sorry-hope that makes sense:eeek:
 
Upvote 0
Maybe something like
Code:
Sub Macro1()
For Each ws In Worksheets
    If ws.Name = ("Sheet2") Then
        Exit Sub
    Else: Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
   ActiveSheet.Name = ("Sheet2")
    End If
Next ws
    ws("Sheet1").Range("A1:ACF2").Copy
    ws("Sheet2").Activate
    ActiveSheet.Paste
End Sub

Personally, I'd use something a little more meaningful than "sheet2"
 
Upvote 0
OOOw !!
That last code was a shocker....no lunch, and no wine yet !!
Code:
Sub Macro1()
Dim ws As Worksheet
For Each ws In Worksheets
    If ws.Name = "Sheet2" Then Exit Sub
Next ws
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Sheet2"
    Worksheets("Sheet1").Activate
    Range("A1:ACF2").Copy Destination:=Worksheets("Sheet2").Range("A1")
End Sub
Personally, I'd use something a little more meaningful than "sheet2"
 
Upvote 0
Thanks for your help guys,

Unfortunately there's a an error coming up and I've got to rush off and won't be able to get to this until Monday!!

I will let you know how i go! :) Hopefully i can figure it out
 
Upvote 0
Okay so i'm having another crack at this and i'm getting an error that says
Runtime error '1004'
Paste Method of Worksheet class failed.


Dim i As Long
Dim formRange As Range '
Range("A1:L2,AO1:AZ2").Select
Selection.Copy
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Sheet2"
ActiveSheet.Paste 'this is where i get the error

I think it might be because i've copied (then added the worksheet) the tried to past?!?!

But I can't write in

Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Sheet2"
Sheet("Sheet1").Activate
Range("A1:L2,AO1:AZ2").Select
Selection.Copy
Sheets("Sheet2").Activate
ActiveSheet.Paste

Because the naming of Sheet1 is different for each workbook :(
(if only i was able to name these spreadsheets/workbooks myself!!!) there's absolutely no consitency
 
Upvote 0
I am just grasping VBA myself, and personally I loath cut and paste.

This may be of some help but doubt it will solve your folder problems, (though you can loop through a folder of workbooks, you do not have to specify each ones name).

All this code does is works with one open workbook.
It copies the range(A1:L2) from one sheet to a new sheet which you name via input box.

It doesn't do anymore than that.
If all your ranges are the same within the workbooks it would work across a folder of workbooks with a few tweaks.

Hope it gives you a few ideas.

Cheers

Code:
Sub FillArray()


Dim MyArray(2, 12) As String
Dim Userinput As String
Dim X, Y As Long

Worksheets("My sheet").Select
Userinput = InputBox("Please enter your sheet name", "Name Worksheet")

  For X = 1 To 2 Step 1
  For Y = 1 To 12 Step 1

  MyArray(X, Y) = Cells(X, Y).Value
 
  Next Y
  Next X

Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Userinput
ActiveSheet.Range("A6:L7") = MyArray

End Sub
 
Upvote 0
If sheet1 keeps having different names, try
Code:
Sub Macro1()
Dim ws As Worksheet
For Each ws In Worksheets
    If ws.Name = "Sheet2" Then Exit Sub
Next ws
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Sheet2"
    Worksheets(1).Activate
    Range("A1:ACF2").Copy Destination:=Worksheets("Sheet2").Range("A1")
End Sub
 
Upvote 0
You've lost me on how what we're doing relates to the original question.

Can you restart this and verbally explain again? I thought we had in post #2, but explain one more time so I can picture what you're trying to accomplish clearly again.
 
Upvote 0

Forum statistics

Threads
1,224,522
Messages
6,179,297
Members
452,903
Latest member
Knuddeluff

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