Esportare foglio lavoro su nuovo file con copia solo dei valori

Question

Un carro saluto a Voi,

vorrei tramite macro esportare/copiare un foglio di lavoro in un nuovo file Excel dove vi siano solo i valori e nessuna formula/codice.
Chiedo il vostro aiuto in quanto il codice seguente, pur generando il nuovo foglio, i dati vengono copiati anche con le formule e il file non viene salvato direttamente.
Il messaggio di errore è: Error: Errore nel metodo Select per la classe Range
Grazie in anticipo. Ciao
Giovanni

Private Sub ExportWorksheets(ByVal WorksheetName As String, ByVal Export_Option As Integer)

On Error GoTo errHandle 

Dim wb As Workbook 

Dim ws As Worksheet 

Dim fileExtension As String 

Dim fileTypeValue As Integer 

fileExtension = Choose(Export\_Option + 1, ".xlsx", ".xls", ".csv", ".pdf") 

fileTypeValue = Choose(Export\_Option + 1, 51, 56, 6, 999) 

Set wb = ActiveWorkbook 

Set ws = wb.Worksheets(WorksheetName) 

ws.Copy 

If fileTypeValue <> 999 Then 

    Application.DisplayAlerts = False 

            With wb.Sheets(1).UsedRange 

                .Cells.Copy 

                .Cells.PasteSpecial xlPasteValues 

                .Cells(1).Select 

            End With 

            Application.CutCopyMode = False 

    ActiveWorkbook.SaveAs fileName:=FolderPath & "\" & WorksheetName & fileExtension, FileFormat:=fileTypeValue 

    ActiveWorkbook.Close False 

    Application.DisplayAlerts = True 

Else: 

        ws.ExportAsFixedFormat \_ 

            Type:=xlTypePDF, \_ 

            fileName:=FolderPath & "\" & WorksheetName & fileExtension, \_ 

            quality:=xlQualityStandard, \_ 

            includeDocProperties:=True, \_ 

            ignorePrintAreas:=False, \_ 

            openafterPublish:=False 

        ActiveWorkbook.Close False 

End If 

CleanObj:

Set ws = Nothing 

Set wb = Nothing 

Exit Sub

Answer 1

Ciao Giovanni,

Mi dispiace ma non trovo il commento

Unfortunatly it doesn't work as expected
Can you please post only the changes if possible? Then I'll arrange the correct position.

molto informativo.

Tuttavia, forse prova la seguente leggera modifica della tua procedura originale:

'========>>

Option Explicit

'-------->>

Private Sub ExportWorksheets(ByVal WorksheetName As String, ByVal Export_Option As Integer)

On Error GoTo Errhandler 

Dim wb As Workbook 

Dim ws As Worksheet 

Dim fileExtension As String 

Dim fileTypeValue As Integer 

Const FolderPath As String = "C:\Users\Giovanni\Documents"            '<<=== Modifica 

fileExtension = Choose(Export\_Option + 1, ".xlsx", ".xls", ".csv", ".pdf") 

fileTypeValue = Choose(Export\_Option + 1, 51, 56, 6, 999) 

Set wb = ActiveWorkbook 

Set ws = wb.Worksheets(WorksheetName) 

ws.Copy 

If fileTypeValue <> 999 Then 

    Application.DisplayAlerts = False 

    wb.Sheets(1).UsedRange.Cells.Copy 

    ActiveSheet.Cells(1).PasteSpecial xlPasteValues 

    Application.CutCopyMode = False 

    ActiveWorkbook.SaveAs Filename:=FolderPath & "\" & WorksheetName & fileExtension, FileFormat:=fileTypeValue 

    ActiveWorkbook.Close False 

    Application.DisplayAlerts = True 

Else 

    ws.ExportAsFixedFormat \_ 

        Type:=xlTypePDF, \_ 

        Filename:=FolderPath & "\" & WorksheetName & fileExtension, \_ 

        quality:=xlQualityStandard, \_ 

        includeDocProperties:=True, \_ 

        ignorePrintAreas:=False, \_ 

        openafterPublish:=False 

    ActiveWorkbook.Close False 

End If 

CleanObj:

Set ws = Nothing 

Set wb = Nothing 

Exit Sub 

Errhandler:

MsgBox "Si è verificato un errore: " & Err.Number & " " & Err.Description 

End Sub

'<<========

===

Regards,

Norman

Answer 2

Unfortunatly it doesn't work as expected
Can you please post only the changes if possible? Then I'll arrange the correct position.

Thanks and Regards
Giovanni

Answer 3

Oh mio Dio. È stato tradotto automaticamente perché non parlo la vostra lingua. Potresti provare a utilizzare un software di traduzione da parte tua?

Grazie

Questa risposta è stata tradotta automaticamente. Di conseguenza, potrebbero esserci errori grammaticali o espressioni strane.

Answer 4

Grazie per la risposta. Si potrebbe avere la versione non tradotta per cortesia? Grazie.
Ciao Giovanni

Answer 5

Ciao

Grazie per aver postato sul forum di oggi. Sono Bambi, un utente come te e sarò felice di aiutarti.

L'errore riscontrato è probabilmente dovuto al fatto che la cartella di lavoro da cui si sta tentando di effettuare la selezione non è attiva nel momento in cui viene chiamato il metodo Select.

Di seguito è riportata una versione rivista del codice che dovrebbe risolvere il problema:

Fogli di lavoro per l'esportazione di sottofogli di lavoro privati(ByVal WorksheetName come stringa, ByVal Export_Option come intero) In caso di errore GoTo errHandle

Dim wb come cartella di lavoro Dim ws come foglio di lavoro Dim newWb come cartella di lavoro Dim fileExtension come stringa Dim fileTypeValue As Integer

fileExtension = Scegli(Export_Option + 1, ".xlsx", ".xls", ".csv", ".pdf") fileTypeValue = Scegli(Export_Option + 1, 51, 56, 6, 999)

Imposta wb = Cartella di lavoro attiva Impostare ws = wb. Fogli di lavoro(NomeFoglioLavoro)

Ws. Copiare Imposta nuovoWb = Cartella di lavoro attiva

Se fileTypeValue <> 999 allora

Application.DisplayAlerts = False Con newWb.Sheets(1). Gamma Usata . Cells.Copy . Cells.PasteSpecial xlPasteValues . Cellule(1). Selezionare Termina con Application.CutCopyMode = False

newWb.SaveAs fileName:=PercorsoCartella & "" & NomeFoglio di Lavoro & Estensione, FileFormat:=fileTypeValue newWb.Close False Application.DisplayAlerts = True

Altro: Ws. ExportAsFixedFormat _ Tipo:=xlTypePDF, _ fileName:=PercorsoCartella & "" & NomeFoglio di Lavoro & EstensioneFile, _ qualità:=xlQualityStandard, _ includeDocProperties:=True, _ ignorePrintAreas:=False, _ openafterPublish:=False

newWb.Close False Fine se

CleanObj: Imposta ws = Niente Set wb = Nothing Imposta nuovoWb = Niente Esci da Sub

errHandle: MsgBox "Si è verificato un errore: " & Err.Description Fine sottomarino

Questo codice crea una nuova cartella di lavoro quando si copia il foglio di lavoro e quindi si opera su tale nuova cartella di lavoro, in modo da evitare l'errore visualizzato. Sostituisci FolderPath con il percorso effettivo in cui desideri salvare il file.

Fammi sapere se questo aiuta o se c'è qualcos'altro in cui posso aiutarti.

Migliori saluti Bambi

Questa risposta è stata tradotta automaticamente. Di conseguenza, potrebbero esserci errori grammaticali o espressioni strane.