macro xls errore in xlsm

max_max

Board Regular
Joined
Jun 29, 2013
Messages
58
Hi to all.
This macro was created in 2010 with excel 2000 and it worked with xls.
Now I changed with save as xlsm but there is an error here:

===========================================================================
wsOri.Copy before:=wbDest.Sheets(1) 'errore qui se questo workbook è in formato XLSM

Set wsDest = wbDest.ActiveSheet

wsDest.Unprotect "123456"
'==========================================================================

the error is this:

(translated with google translator)

1004 run-time error
impossible to insert the sheets in the destination workbook because
contains fewer rows and columns than the
work of origin. To move or copy data in the workbook of
destination, you can select them, then in the sheets of another
workbook using the Copy and Paste commands

the macro:


Code:
Option Explicit

'per salvare nelle cartelle modif. 16_06_16

Sub CopiaESalvaInPathX()
    
'-----------------------------------------------------------------------------------------
'avviso all'avvio

Dim avviso As String


 
 avviso = MsgBox("Sign. " & Environ("UserName") & " save sheet?" _
 & Chr(13) & "" _
 & Chr(13) & "attention:", _
 vbQuestion + vbYesNo + vbDefaultButton2, "xxxxxxxxxxxxxx")
 
 
  If avviso = 7 Then
  
   ActiveSheet.Protect "123456"
   
  Exit Sub
  End If
  
  
  If ActiveSheet.Range("Q2") = "" Or ActiveSheet.Range("T2") = "" Then
     
  
   avviso = MsgBox("Sign. " & Environ("UserName") & "" _
   & Chr(13) & "name name1/name2", _
   vbCritical, "attention")
 
 
   'If avviso = 7 Then
   'ActiveSheet.Protect "123456"
   
  Exit Sub
  End If
  
  
  
  
 '-----------------------------------------------------------------------------------------
   'dichiarazioni delle variabili

   Dim wbOri As Workbook
   Dim wsOri As Worksheet
   Dim wbDest As Workbook
   Dim wsDest As Worksheet
   Dim sh As Worksheet
   Dim sPath As String
   Dim sComm1, sComm2, sComm3, sComm4, sComm5, sComm6, sComm7 As String
   Dim sWS As String
   Dim sWB As String
   Dim sData As String
   Dim sNomeFile As String
   Dim nSfx As Long
   Dim nFogliNew As Long
   Dim oShp As Shape
   Dim savechanges As Long
  
   Dim FSO As Object
   
   Dim shp As Shape
   Dim testStr As String
    
   Dim estensione As String
   
   'Const xlExcel8 As Long = 56
   'Const xlOpenXMLWorkbook As Long = 51
   
 '-------------------------------------------------------------------------------------
  'per visualizzare errori
  
   On Error GoTo gest_err
   
 '-------------------------------------------------------------------------------------
   'impostazioni applicazione
 
   With Application
     .DisplayAlerts = False
     .ScreenUpdating = False
     nFogliNew = .SheetsInNewWorkbook
     .SheetsInNewWorkbook = 1
      .EnableEvents = False '<<< aggiunto
                                           
   End With
   
 '-------------------------------------------------------------------------------------
   'set degli oggetti
   
   Set wbOri = ThisWorkbook
   Set wsOri = wbOri.ActiveSheet
   Set wbDest = Application.Workbooks.Add
    
   sWS = wsOri.Name
   
   
'-----------------------------------------------------------------------------------------
  'indirizzo path di salvataggio
  
  sComm4 = wsOri.Range("Q2").Value '<<< cartella nome cella
  sComm5 = wsOri.Range("T2").Value '<<< cartella nome cella
  sComm6 = sComm4 & "-" & sComm5   '<<< cartella nome cella
    
  
       
   sPath = "C:\Users\massimo\Desktop\moduli_salvati\" & sComm6 'casa_new
   
   'sPath = "J:\moduli_falegnami_salvati\" & sComm6 'ufficio cartella comune
   
   
   
  
   'sPath = "C:\Users\xxxxxxxx\Desktop\moduli_salvati\" & sComm6 '<<<<<  new

   
   '---------------------------------------------------
   'crea in automatico cartella
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(sPath) Then
    FSO.CreateFolder sPath
    End If
   '---------------------------------------------------


'---------------------------------------------------------------------------------------
'nomi celle nel nome di salvataggio

    sComm1 = wsOri.Range("C3").Value
    sComm2 = wsOri.Range("C4").Value
    sComm3 = wsOri.Range("G4").Value
    
      
   sData = Format(Date, "dd-mm-yyyy")
  
   sWB = "MOD_FAL. COMM. " & sComm1 & " - " & sComm2 & " - " & sComm3 & " (" & sData & ")"
  
   
'--------------------------------------------------------------------------------------
'=========================================================================================


   wsOri.Copy before:=wbDest.Sheets(1) 'errore qui se questo workbook è in formato XLSM
        
   Set wsDest = wbDest.ActiveSheet
   
   'wsDest.Unprotect "123456"
   
   
'=========================================================================================




























    
'=========================================================================================
   'togliere l'istruzione successiva se il foglio salvato non deve essere protetto
   
   'wsDest.Protect "123456"
   
 '-------------------------------------------------------------------------------------------
 'per fermarsi nella cella del foglio salvato
 
  Range("C3").Select
 'Application.Goto Reference:=Range("C3"), scroll:=True
 
 '-------------------------------------------------------------------------------------------
                                          
    
 '-------------------------------------------------------------------------------------------
 
   sPath = sPath & "\" & sWS
   
   For Each sh In wbDest.Sheets
     If sh.Name <> wsDest.Name Then
       sh.Delete
     End If
   Next
   
 '-------------------------------------------------------------------------------------
   'controllo/creazione dir da nome foglio
 
   If Dir(sPath, vbDirectory) = vbNullString Then
     MkDir (sPath)
   End If
   
 '--------------------------------------------------------------------------------------
 'loop per creazione nome file progressivo

 Do
 nSfx = nSfx + 1

 '--------------------------------------------------------------------------------------
 'estensione salvataggio

'estensione = ".xls" ' oppure xlsx

estensione = ".xlsx" ' oppure xls
   
sNomeFile = sPath & "\" & sWB & " - " & nSfx & estensione  'con numero progressivo
'sNomeFile = sPath & "\" & sWB & estensione  'senza numero progressivo

'--------------------------------------------------------------------------------------
'loop per creazione nome file progressivo

  Loop While Dir(sNomeFile) <> vbNullString
  
'--------------------------------------------------------------------------------------
'estensione salvataggio

 'If estensione = ".xls" Then
 
'If Val(Application.Version) < 12 Then
'ActiveWorkbook.SaveAs Filename:=sNomeFile
'Else
'ActiveWorkbook.SaveAs Filename:=sNomeFile, FileFormat:=xlExcel8
'End If

'Else

ActiveWorkbook.SaveAs Filename:=sNomeFile, FileFormat:=xlOpenXMLWorkbook '<<< per formato xslx

'End If
  
'--------------------------------------------------------------------------------------
'se si vuole non si vuole visualizzare il nuovo file togliere l'istruzione successiva (togliere Option Explicit)
   
   wbDest.Close savechanges = True
   
'--------------------------------------------------------------------------------------
 'per visualizzare errori
 
gest_err:
   If Err.Number <> 0 Then
     MsgBox "Errore " & Err.Number & ": " & Err.Description, vbCritical, "Errore"
   End If
   
'--------------------------------------------------------------------------------------
     
   Set wsOri = Nothing
   Set wbOri = Nothing
   Set wsDest = Nothing
   Set wbDest = Nothing
   
   With Application
     .ScreenUpdating = True
     .DisplayAlerts = True
     .SheetsInNewWorkbook = nFogliNew
      .EnableEvents = True
   End With

 
  Application.ScreenUpdating = True
  
  
  'End If
 End Sub

an aid to correct?
max_max
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Cross posted https://www.excelforum.com/excel-pr...32928-macro-to-copy-sheets-error-if-xlsm.html

Cross-Posting
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

and here http://www.vbaexpress.com/forum/showthread.php?62895-errore&highlight=
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

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