Page 1 of 2 1 2 LastLast
Results 1 to 10 of 14

Thread: Macro to create line at selected location and in multiple workbooks

  1. #1

    Macro to create line at selected location and in multiple workbooks



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi Folks, long time lurker first time poster!*


    I need a macro for 5 workbooks (not sheets) for different teams that would allow me to insert a line based on the row selected in each by just using one of them.


    The workbooks are called conduct team, strategy team, planning team, forecast team and results team.


    I.e I open up conduct team select a row and run the macro so it creates a line at that selected row and in the other team workbooks too in the same location.*


    Can it be done!??


    Thank you very much !*

    If it can be done once contents were added to this row could it reflect in the other workbooks also.

    James

  2. #2
    Conjurer WizzardOfOz's Avatar
    Join Date
    Sep 2013
    Location
    Australia
    Posts
    184
    Articles
    0
    yes here are two macros created for each of the scenarios.
    Code:
    Option Explicit
    
    
    Sub InsertRowsHere()
    'must be in a sheet and on a row e.g. A4
    Dim aSheet, oShts
    Dim iRow As Long
    
    
        oShts = Array("conduct team", "strategy team", "planning team", "forecast team", "results team")
        iRow = ActiveCell.Row      'get which row
        For Each aSheet In oShts
            Sheets(aSheet).Rows(iRow).Insert
        Next
        
    End Sub
    
    
    Sub CopyRowsHere()
    Dim aSheet, oShts, aRange As Range
    Dim iRow As Long
    'must first select a region to copy e.g. sheet1!A4:C10
        oShts = Array("conduct team", "strategy team", "planning team", "forecast team", "results team")
         
        Set aRange = Selection
        For Each aSheet In oShts
            If aSheet <> ActiveSheet.Name Then _
                Sheets(aSheet).Range(aRange.Address).Value2 = aRange.Value2
        Next
        
    End Sub

  3. #3
    Quote Originally Posted by WizzardOfOz View Post
    yes here are two macros created for each of the scenarios.
    Code:
    Option Explicit
    
    
    Sub InsertRowsHere()
    'must be in a sheet and on a row e.g. A4
    Dim aSheet, oShts
    Dim iRow As Long
    
    
        oShts = Array("conduct team", "strategy team", "planning team", "forecast team", "results team")
        iRow = ActiveCell.Row      'get which row
        For Each aSheet In oShts
            Sheets(aSheet).Rows(iRow).Insert
        Next
        
    End Sub
    
    
    Sub CopyRowsHere()
    Dim aSheet, oShts, aRange As Range
    Dim iRow As Long
    'must first select a region to copy e.g. sheet1!A4:C10
        oShts = Array("conduct team", "strategy team", "planning team", "forecast team", "results team")
         
        Set aRange = Selection
        For Each aSheet In oShts
            If aSheet <> ActiveSheet.Name Then _
                Sheets(aSheet).Range(aRange.Address).Value2 = aRange.Value2
        Next
        
    End Sub
    Super thank you so much I'll check it works when I get in to the office. Many thanks for helping😁

  4. #4
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    370
    Articles
    0
    Excel Version
    2020
    Please do not Quote.

    this suffices:

    Code:
    Sub M_snb()
        For Each wb In Workbooks
          wb.Sheets(1).Shapes.AddConnector(1, 0, ActiveCell.Top, 539.4, ActiveCell.Top).Line.Weight = 3
        Next
    End Sub

  5. #5
    Quote Originally Posted by WizzardOfOz View Post
    yes here are two macros created for each of the scenarios.
    Code:
    Option Explicit
    
    
    Sub InsertRowsHere()
    'must be in a sheet and on a row e.g. A4
    Dim aSheet, oShts
    Dim iRow As Long
    
    
        oShts = Array("conduct team", "strategy team", "planning team", "forecast team", "results team")
        iRow = ActiveCell.Row      'get which row
        For Each aSheet In oShts
            Sheets(aSheet).Rows(iRow).Insert
        Next
        
    End Sub
    
    
    Sub CopyRowsHere()
    Dim aSheet, oShts, aRange As Range
    Dim iRow As Long
    'must first select a region to copy e.g. sheet1!A4:C10
        oShts = Array("conduct team", "strategy team", "planning team", "forecast team", "results team")
         
        Set aRange = Selection
        For Each aSheet In oShts
            If aSheet <> ActiveSheet.Name Then _
                Sheets(aSheet).Range(aRange.Address).Value2 = aRange.Value2
        Next
        
    End Sub
    Hi this is what I am after although it only works if the teams are in the same spreadsheet under different tabs. Each team workbook is a separate excel file. How could we change to apply to separate workbooks. They are all saved in folder c: \Teams if that helps? Many thanks

  6. #6
    Conjurer WizzardOfOz's Avatar
    Join Date
    Sep 2013
    Location
    Australia
    Posts
    184
    Articles
    0
    Quote Originally Posted by snb View Post
    Please do not Quote.

    this suffices:

    Code:
    Sub M_snb()
        For Each wb In Workbooks
          wb.Sheets(1).Shapes.AddConnector(1, 0, ActiveCell.Top, 539.4, ActiveCell.Top).Line.Weight = 3
        Next
    End Sub
    LOL, yeah right I suppose we both misread part of the question.

  7. #7
    Conjurer WizzardOfOz's Avatar
    Join Date
    Sep 2013
    Location
    Australia
    Posts
    184
    Articles
    0
    Yes sorry I misread that. Minor changes mostly around changing Sheets(asheet) to Workbooks(asheet).Sheets(1)
    Need to check if it is already opened and also presuming it's sheet 1.
    Are we to presume the other sheets are opened/closed and also save & close if required
    Busy day ahead, I may not get around to it today

  8. #8
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    370
    Articles
    0
    Excel Version
    2020
    Don't think so:


    Sub M_snb()
    For Each wb In Workbooks

  9. #9
    Conjurer WizzardOfOz's Avatar
    Join Date
    Sep 2013
    Location
    Australia
    Posts
    184
    Articles
    0
    Code below, assuming that we want to work in sheet1 for each workbook

    Code:
    Option Explicit
    Dim aSheet, oShts
    Const sPath As String = "C:\temp\"  'with the trailing backslash
    
    
    Public Function Arr()
        Arr = Array("conduct team.xlsx", "strategy team.xlsx", "planning team.xlsx", "forecast team.xlsx", "results team.xlsx")
    End Function
    
    
    Sub InsertRowsHere()
    'must be in a sheet and on a row e.g. A4
    Dim iRow As Long
    
    
        If IsEmpty(oShts) Then oShts = Arr    'create the array if it does not exist
        iRow = ActiveCell.Row      'get which row
        
        For Each aSheet In oShts
                Workbooks(aSheet).Sheets(1).Rows(iRow).Insert
        Next
        
    End Sub
    
    
    Sub CopyRowsHere()
    Dim aRange As Range
    Dim iRow As Long
    'must first select a region to copy e.g. sheet1!A4:C10
        If IsEmpty(oShts) Then oShts = Arr    'create the array if it does not exist
         
        Set aRange = Selection
        For Each aSheet In oShts
            If aSheet <> ActiveWorkbook.Name Then _
                Workbooks(aSheet).Sheets(1).Range(aRange.Address).Value2 = aRange.Value2
        Next
        
    End Sub
    
    
    Sub OpenAllFiles()
    Dim wb As Workbook
        
        If IsEmpty(oShts) Then oShts = Arr    'create the array if it does not exist
        On Error Resume Next                  'needed as we are calling workbooks which may not be open
        For Each aSheet In oShts
            Set wb = Workbooks(aSheet)
            If wb Is Nothing Then Workbooks.Open (sPath & aSheet)
            Set wb = Nothing
        Next
        On Error GoTo 0
    End Sub
    
    
    Sub CloseAllFiles()
        
        If IsEmpty(oShts) Then oShts = Arr    'create the array if it does not exist
        
        For Each aSheet In oShts
            Workbooks(aSheet).Close (True)
        Next
        
    End Sub
    Last edited by WizzardOfOz; 2014-10-31 at 03:02 AM.

  10. #10
    Many Thanks Wizard of Oz! this works great. One last thing if I only wanted to copy and paste certain cells with in the row what should the code be altered to?

    I.e to have the function as before to highlight the row but then only copy cells A10 to H10 and then K10 to P10 and then paste to other workbooks as before (so leaving two cells out in the middle.

    Many Thanks!!

Page 1 of 2 1 2 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •