Results 1 to 4 of 4

runtime error "1004' Command is not available in a shared workbook

This is a discussion on runtime error "1004' Command is not available in a shared workbook within the Excel Questions forums, part of the Question Forums category; Hi guy, i have this code for copying diffrent ranges of cells and saving it in different workbooks: Sub NewCopy() ...

  1. #1
    New Member
    Join Date
    Feb 2013
    Posts
    29

    Default runtime error "1004' Command is not available in a shared workbook

    Hi guy,

    i have this code for copying diffrent ranges of cells and saving it in different workbooks:

    Sub NewCopy()

    Dim strFileName As String
    Dim range1 As Range
    Dim rng1 As Range, rng2 As Range, myMultiRanges As Range
    Worksheets("ACL & History").Activate
    Set rng1 = Range("A1:E7")
    Set rng2 = Range("A80:E86")
    Set myMultiRanges = Union(rng1, rng2)
    myMultiRanges.Select


    strFileName = InputBox("Type a name for the new workbok", "File Name")
    If Trim(strFileName) = vbNullString Then Exit Sub

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Selection.Copy
    Sheets.Add.Range("A1").PasteSpecial xlPasteAll
    Application.CutCopyMode = False
    ActiveSheet.UsedRange.EntireColumn.AutoFit
    ActiveSheet.Move
    ActiveWorkbook.SaveAs "C:\Users\zztongl\" & strFileName & ".xlsm", xlOpenXMLWorkbookMacroEnabled
    ActiveWorkbook.Close False

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    End Sub



    the problem is when is share the workbook, it generated the runtime error '1004' Command is not available in a shared workbook...can anyone help me to make it work even in a shared workbook.



    thanks in advance guys,
    this forum really helped me with my vba questions

  2. #2
    Board Regular
    Join Date
    Jul 2012
    Posts
    72

    Cool Re: runtime error "1004' Command is not available in a shared workbook

    @bigpappi

    Hi

    You can't move the sheet in shared workbook

    with your code please remove the line

    Activesheet.Move

    changed code is

    Code:
    Sub NewCopy()
        
        Dim strFileName As String
        Dim range1 As Range
        Dim rng1 As Range, rng2 As Range, myMultiRanges As Range
        Worksheets("ACL & History").Activate
        Set rng1 = Range("A1:E7")
        Set rng2 = Range("A80:E86")
        Set myMultiRanges = Union(rng1, rng2)
        myMultiRanges.Select
    
       
        strFileName = InputBox("Type a name for the new workbok", "File Name")
        If Trim(strFileName) = vbNullString Then Exit Sub
        
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        Selection.Copy
        Sheets.Add.Range("A1").PasteSpecial xlPasteAll
        Application.CutCopyMode = False
        ActiveSheet.UsedRange.EntireColumn.AutoFit
    ActiveWorkbook.SaveAs "C:\Users\zztongl\" & strFileName & ".xlsm", xlOpenXMLWorkbookMacroEnabled
        ActiveWorkbook.Close False
        
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
        
    End Sub

    Hope it will solve your problem other wise please inform

    Thanks

    Patnaik
    Last edited by sgmpatnaik; Mar 15th, 2013 at 09:00 AM. Reason: code

  3. #3
    New Member
    Join Date
    Feb 2013
    Posts
    29

    Default Re: runtime error "1004' Command is not available in a shared workbook

    @sgmpatnaik

    Hi

    the code works in a shared workbook but it copies all the worksheet. i just want to copy the selection

    thanks,

  4. #4
    Board Regular
    Join Date
    Jul 2012
    Posts
    72

    Default Re: runtime error "1004' Command is not available in a shared workbook

    @bigpappi23

    sorry for my late replay just i was busy with my work, please try the below code

    Code:
    Sub NewCopy()
    Dim strFileName As String
    
    Dim rng1 As Range, rng2 As Range, myMultiRanges As Range
    Dim wbDest As Workbook
    
    Worksheets("ACL & History").Activate
    
    Set rng1 = Range("A1:E7")
    Set rng2 = Range("A80:E86")
    Set myMultiRanges = Union(rng1, rng2)
    
    strFileName = InputBox("Type a name for the new workbok", "File Name")
    If Trim(strFileName) = vbNullString Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set wbDest = Workbooks.Add
    
    With wbDest
        With .Sheets("Sheet1")
            myMultiRanges.Copy .Range("A1")
            .UsedRange.EntireColumn.AutoFit
        End With
        .SaveAs "C:\Users\zztong1\" & strFileName & ".xlsx", xlOpenXMLWorkbook
        .Close
    End With
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    End Sub
    If any problem please refer us

    Thanks

    Patnaik
    Last edited by sgmpatnaik; Mar 25th, 2013 at 03:08 AM. Reason: for get tag

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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


DMCA.com