Insert Rows/Move Data in multiple worksheets based on worksheet names using wildcards in all workbooks in a specific folder

[suzeeq]

I am trying to insert rows in multiple worksheets (in multiple workbooks in a specific folder but I have that part already coded) using the worksheet name. After the rows are inserted, I want to move a range of data that already exists in each ws to those newly inserted rows. This is a worksheet that I made for myself that my organization liked and distributed/rolled out to multiple accounts and now I've been asked to make some updates to accommodate the other users' needs.

There are over 60 ws in the wb and the 48 I want to update use the naming convention "P## Week #" and am thinking there must be a way to use wildcards rather than listing the 48 ws in an array. If this isn't possible, I can insert a ws in each wb in the folder with the 48 ws names listed for the code to reference. Each of the 48 worksheets has the exact same format and is password protected.

I want to insert 10 rows after row 20 and move range F12:H27 to range A22:C37.

Since the data I want in these new rows is already in each worksheet and used in formulas, I was hoping I could "move" rather than "copy/paste" to maintain the integrity of the formulas.
I will modify the unprotect and protect subs so the password doesn't need to be entered for each wb.

Sub template_for_code_applied_to_all_workbooks_in_folder()
    Dim ws As Worksheet
    Dim wb As Workbook, path As String, pathstr As String
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False 
        pathstr = "c:\data\COGA\"
        path = Dir(pathstr)       
        Do
            Set wb = Workbooks.Open(pathstr & path)
           
            'insert code you want run on all the workbooks in the file folder
           
            Call UnprotectAllWorksheets
                       
            'insert code you want to run on all the worksheets in the open workbook
           
           
            'end of code you want to run on all the worksheets in the open workbook
        
            Call ProtectAllWorksheets
           
            'end of code you want run on all the workbooks in the file folder   
           
            wb.Close savechanges:=True
            path = Dir
        Loop Until Len(path) = 0       
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub



Sub UnprotectAllWorksheets()

On Error GoTo booboo
unpass = InputBox("please enter the password:")
For Each Worksheet In ActiveWorkbook.Worksheets
Worksheet.Unprotect Password:=unpass
Next
Exit Sub
booboo: MsgBox "There is a problem - check your password"


End Sub

Sub ProtectAllWorksheets()

Dim ws As Worksheet
unpass = InputBox("please enter the password:")
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:=unpass
Next ws
End Sub

 

[suzeeq]

I figured out the following coding works to insert rows and move data. May not be the cleanest way to do it but it works. Now to test it inside the above coding.

Sub insertrowsmultiplesheets()
'
' testinsertrowsmultiplesheets Macro
'

'
    Call UnprotectAllWorksheets
    
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim wb As Workbook
                  
   

   For Each ws In ActiveWorkbook.Worksheets
       
         If ws.Name Like "P?? Week*" Then
       
    ws.Activate
    ws.Rows("21:30").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveWindow.SmallScroll Down:=9
    ws.Range("F31:H37").Select
    Selection.Cut Destination:=ws.Range("F21:H27")
    ws.Range("F13:G27").Select
    Selection.Cut Destination:=ws.Range("A22:B36")
    ws.Range("H27").Select
    Selection.Cut Destination:=ws.Range("C36")
    ws.Range("H15:K19").Select
    Selection.Cut Destination:=ws.Range("C22:F26")
    ws.Range("C22:F26").Select
        Else
        End If
    Next ws
           
    Application.ScreenUpdating = True
    
    Call ProtectAllWorksheets
    
End Sub

 

[suzeeq]

Modified slightly and tested.

Sub template_for_code_applied_to_all_workbooks_in_folder()

    Dim ws As Worksheet
    Dim wb As Workbook, path As String, pathstr As String
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
        pathstr = "c:\data\COGA\"
        path = Dir(pathstr)
        
        Do
            Set wb = Workbooks.Open(pathstr & path)
            
            'insert code you want run on all the workbooks in the file folder
            
                                    
            'insert code you want to run on all the worksheets in the open workbook
           
            
            Call insertrowsmultiplesheets
            
            'end of code you want to run on all the worksheets in the open workbook
         
                      
            'end of code you want run on all the workbooks in the file folder
            
           
            
            wb.Close savechanges:=True
            path = Dir
        Loop Until Len(path) = 0
        
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub


Sub insertrowsmultiplesheets()
'
' testinsertrowsmultiplesheets Macro
'

'
       
      For Each ws In ActiveWorkbook.Worksheets
       
         If ws.Name Like "P?? Week*" Then
       
    ws.Activate
    ws.Protect Password:="Ch@rtwells", UserInterFaceOnly:=True
    ws.Rows("21:30").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveWindow.SmallScroll Down:=9
    ws.Range("F31:H37").Select
    Selection.Cut Destination:=ws.Range("F21:H27")
    ws.Range("F13:G27").Select
    Selection.Cut Destination:=ws.Range("A22:B36")
    ws.Range("H27").Select
    Selection.Cut Destination:=ws.Range("C36")
    ws.Range("H15:K19").Select
    Selection.Cut Destination:=ws.Range("C22:F26")
    ws.Range("C22:F26").Select
        Else
        End If
    Next ws
           
    
   
    
End Sub