Re Using Same Macro In Different Workbooks

[russlock]

Good morning and i hope someone is able to help.

I have a couple of hundred customer spreadsheets with their product prices on and we are implementing a price increase, so I have a formula in a different spreadsheet which I copy into each customers spreadsheet which changes all their prices. I set this up as a macro to copy and paste the formula but I am having problems where the macro only references the current spreadsheet. if I open a new customers spreadsheet and run the same macro, I hit an error and I think it is the Windows("Test1.xlsx").Activate part below. Is there a way to reference ("current open spreadsheet") for example?

I am sure there are easier ways to achieve what I am looking to do, I just want to cut down on the repetitive work.

many thanks



-----------------

Sub Copy()
'
' Copy Macro
'
' Keyboard Shortcut: Ctrl+a
'
Windows("Copy of CCP-price increase formula-Sheet2").Activate
Selection.Copy
Windows("Test1.xlsx").Activate
ActiveSheet.Paste
Range("H2:J2").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("H2:J885")
Range("H2:J885").Select
End Sub

 

[russlock]

I'm glad to see others are here helping you with this need of your.
When attempting to do something like. There is a need for a lot of very specific details. Like the path to the folder where all these workbooks are located. Do we do all the workbooks in the folder or just some. If it is just some then we would need the name of all 200 workbooks and the sheet names and the ranges and maybe more .
This is beyond my knowledgebase.
I will continue to monitor this thread to see what I can learn.

I can put them all In the same folder, no problem and it we were able to do all in the same folder at the same time, that would be immense. The structure of each workbook is exactly the same, just some of the headers have the customer name in them. Not sure if this would cause issues?

Many thanks

 

[russlock]

Thank for the update and let me know how you go.
It sounds like you will need to specify a range where I have put in "usedrange" as being the range to copy. If you need help with that just let me know.

I tested it Alex after putting four customer workbooks in the same folder and it worked spot on with the very small exception of it pulling through the first two rows from the formula workbook and adding that to each of the other workbooks. This won't work as two of the headers are what our system reads to know which customer to update with these price. (see image)

secondly, if i were to do a few other things with those imported columns, like move one of them, remove formula so i only have the values, delete a column and copy a different one to the first column so i can do a vlookup,would this be difficult to add in to your code? I guess it would go XX Action part of procedure? i have recorded a macro so you can see what i mean.
Also, is it possible for the code to only see the amount of active rows as each row is a particual product a customer takes and each customer will have more or less than other, so for example, this one has 560, but others could have more and the code would only go as far as 560 wouldn't it?

please excuse my ignorance on VBA. I am starting to slowly understand how things work but nowhere near the ability to do this yet

i have put the formula and a couple of the customers workbooks in dropbox if this helps.

Dropbox - File Deleted - Simplify your life

www.dropbox.com

Dropbox - File Deleted - Simplify your life

www.dropbox.com

Dropbox - Error - Simplify your life

www.dropbox.com

many thank to all for your help.

==================


Sub Macro3()
'
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+a
'
Windows("Copy of CCP-price increase formula-Sheet2.xlsx").Activate
Range("H1:J2").Select
Selection.Copy
Windows("ChannelPricesExport_Allerton_637700840428261672.xlsx").Activate
ActiveSheet.Paste
Columns("F:F").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("K:K").Select
Selection.Cut Destination:=Columns("F:F")
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F560")
Range("F2:F560").Select
Range("G1").Select
Selection.AutoFill Destination:=Range("F1:G1"), Type:=xlFillDefault
Range("F1:G1").Select
Range("I2:J2").Select
Selection.AutoFill Destination:=Range("I2:J560")
Range("I2:J560").Select
Columns("F:F").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("I:J").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Selection.Copy
Columns("A:A").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
End Sub

 

[Alex Blakenburg]

Look I don't really understand what you are saying above.
Based on the workbooks you linked I would have thought that all you need to do is copy in the formulas from Columns H:J.

I have modified the code to do that. You shouldn't need to make any changes before you run it but you do still need to have the formulas workbook open.
Try this and then explain to me what other changes you need.

Sub LoopAllExcelFilesInFolder()
    'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
    'SOURCE: www.TheSpreadsheetGuru.com
    'Modified by Alex for MrExcel Question
    
    Dim destWB As Workbook                      'XXX Changed for clarity
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    
    'XXX Modification for active part of Procedure
    Dim destSht As Worksheet
    Dim srcWB As Workbook
    Dim srcSht As Worksheet
    Dim destRng As Range                        'XXY Added 18/10/2021
    Dim destLastRow As Long                     'XXY Added 18/10/2021
    Set srcWB = Workbooks("Copy of CCP-price increase formula-Sheet2.xlsx")     'XXX Change to Workbook containing formula
    'Set srcWB = Workbooks("Workbook1.xlsm")     'XXX Change to Workbook containing formula
    Set srcSht = srcWB.Worksheets("Sheet2")     'XXX Change to Workbook containing formula
    
    'Optimize Macro Speed
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      Application.Calculation = xlCalculationManual
    
    'Retrieve Target Folder Path From User
      Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
        With FldrPicker
          .Title = "Select A Target Folder"
          .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NextCode
            myPath = .SelectedItems(1) & Application.PathSeparator
        End With
    
    'In Case of Cancel
NextCode:
      myPath = myPath
      If myPath = "" Then GoTo ResetSettings
    
    'Target File Extension (must include wildcard "*")
      myExtension = "*.xls*"
    
    'Target Path with Ending Extention
      myFile = Dir(myPath & myExtension)
    
    'Loop through each Excel file in folder
      Do While myFile <> ""
        'Set variable equal to opened workbook
          Set destWB = Workbooks.Open(Filename:=myPath & myFile)
          Set destSht = destWB.Worksheets("Sheet1")                     'XXX Confirm this is the sheet to use
        
        'Ensure Workbook has opened before moving on to next line of code
          DoEvents
        
        'XXX Action part of Procedure
        destLastRow = destSht.Cells(Rows.Count, "G").End(xlUp).Row                              'XXY Added 18/10/2021
        Set destRng = destSht.Range(destSht.Cells(2, "H"), destSht.Cells(destLastRow, "J"))     'XXY Added 18/10/2021
        srcSht.Range("H2:J2").Copy destRng                                                      'XXY Changed 18/10/2021
        srcSht.Range("H1:J1").Copy destSht.Range("H1")                                          'XXY Added 18/10/2021 - Copy headings
        Application.CutCopyMode = False
        destSht.Activate
        'destSht.Range("H2:J885").Select ' Not sure why you would want to do this
        destSht.Range("H2").Select                                                                  'XXY Added 18/10/2021
        
        'Save and Close Workbook
          destWB.Close SaveChanges:=True
          
        'Ensure Workbook has closed before moving on to next line of code
          DoEvents
    
        'Get next file name
          myFile = Dir
      Loop
    
    'Message Box when tasks are completed
      MsgBox "Task Complete!"
    
ResetSettings:
      'Reset Macro Optimization Settings
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True

End Sub

 

[russlock]

Look I don't really understand what you are saying above.
Based on the workbooks you linked I would have thought that all you need to do is copy in the formulas from Columns H:J.

I have modified the code to do that. You shouldn't need to make any changes before you run it but you do still need to have the formulas workbook open.
Try this and then explain to me what other changes you need.

Sub LoopAllExcelFilesInFolder()
    'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
    'SOURCE: www.TheSpreadsheetGuru.com
    'Modified by Alex for MrExcel Question
   
    Dim destWB As Workbook                      'XXX Changed for clarity
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
   
    'XXX Modification for active part of Procedure
    Dim destSht As Worksheet
    Dim srcWB As Workbook
    Dim srcSht As Worksheet
    Dim destRng As Range                        'XXY Added 18/10/2021
    Dim destLastRow As Long                     'XXY Added 18/10/2021
    Set srcWB = Workbooks("Copy of CCP-price increase formula-Sheet2.xlsx")     'XXX Change to Workbook containing formula
    'Set srcWB = Workbooks("Workbook1.xlsm")     'XXX Change to Workbook containing formula
    Set srcSht = srcWB.Worksheets("Sheet2")     'XXX Change to Workbook containing formula
   
    'Optimize Macro Speed
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      Application.Calculation = xlCalculationManual
   
    'Retrieve Target Folder Path From User
      Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
   
        With FldrPicker
          .Title = "Select A Target Folder"
          .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NextCode
            myPath = .SelectedItems(1) & Application.PathSeparator
        End With
   
    'In Case of Cancel
NextCode:
      myPath = myPath
      If myPath = "" Then GoTo ResetSettings
   
    'Target File Extension (must include wildcard "*")
      myExtension = "*.xls*"
   
    'Target Path with Ending Extention
      myFile = Dir(myPath & myExtension)
   
    'Loop through each Excel file in folder
      Do While myFile <> ""
        'Set variable equal to opened workbook
          Set destWB = Workbooks.Open(Filename:=myPath & myFile)
          Set destSht = destWB.Worksheets("Sheet1")                     'XXX Confirm this is the sheet to use
       
        'Ensure Workbook has opened before moving on to next line of code
          DoEvents
       
        'XXX Action part of Procedure
        destLastRow = destSht.Cells(Rows.Count, "G").End(xlUp).Row                              'XXY Added 18/10/2021
        Set destRng = destSht.Range(destSht.Cells(2, "H"), destSht.Cells(destLastRow, "J"))     'XXY Added 18/10/2021
        srcSht.Range("H2:J2").Copy destRng                                                      'XXY Changed 18/10/2021
        srcSht.Range("H1:J1").Copy destSht.Range("H1")                                          'XXY Added 18/10/2021 - Copy headings
        Application.CutCopyMode = False
        destSht.Activate
        'destSht.Range("H2:J885").Select ' Not sure why you would want to do this
        destSht.Range("H2").Select                                                                  'XXY Added 18/10/2021
       
        'Save and Close Workbook
          destWB.Close SaveChanges:=True
         
        'Ensure Workbook has closed before moving on to next line of code
          DoEvents
   
        'Get next file name
          myFile = Dir
      Loop
   
    'Message Box when tasks are completed
      MsgBox "Task Complete!"
   
ResetSettings:
      'Reset Macro Optimization Settings
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True

End Sub

The customers names remain in their header now Alex, which is perfect and thank you for your help as i couldn't have done this. just saved me many hours of tedious work. Much appreciated. I have another lookup to do on these workbooks when they are all changed so am going to try any play with this code to make another task easier (making sure all above is copied safely ). If i could buy you a beer i would

 

[Alex Blakenburg]

I appreciate the sentitiment, glad I could help.
If you have any more specific questions, just open a new thread and if you send me a link, I will take a look.