Macro per cancellare foglio e copiare contenuto da differenti files

Question

Ciao a tutt*.

Chiedo una mano a voi super esperti per finalizzare una vba.

Spiego prima cosa dovrebbe succedere, e poi condivido quanto ho già scritto (ma non sono sicuro che sia giusto).

• Ho 2 files: "Aggregato" (dal quale far partire le macro) e "Inviati"
• Il file "Aggregato" è composto da due fogli:
  • Confronto
  • Report
• Il file "Inviati" ha un unico foglio (Foglio 1)
• La macro presente sul file "Aggregato" dovrebbe effettuare le seguenti operazioni:
  • Cancellare tutto il contenuto del foglio "Confronto"
  • Cancellare il contenuto del foglio Report nelle sole colonne A-F, da riga 2 fino all'ultima riga compilata
  • Aprire un file .txt presente in una determinata cartella
  • Copiare il contenuto del file .txt nella colonna A del foglio "Confronto"
  • Chiudere il foglio .txt (chiudendo anche i due pop-up che si creano: la richiesta di salvare il file e di mantenere il contenuto degli appunti)
  • Aprire il foglio "Inviati"
  • Copiare il contenuto del foglio "Foglio 1" nelle sole colonne A-F, da riga 2 fino all'ultima riga compilata
  • Selezionare il file "Aggregato", foglio "Report" e incollare il contenuto appena copiato nelle colonne A-F, da riga 2 fino all'ultima riga necessaria
  • Confermare che è avvenuto tutto correttamente.

Per il momento ho scritto questo codice, ma credo che ci sia qualcosa che non va:

Sub Step_2()

' CANCELLA CONTENUTO PRECEDENTE

    Sheets("Confronto").Select 

    Cells.Select 

    Selection.ClearContents 

'

' IMPORTA FILE TXT

'

Workbooks.OpenText Filename:="C:\File.txt", Origin:= \_ 

    xlWindows, StartRow:=6, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, \_ 

    9), Array(10, 9), Array(21, 9), Array(36, 1)), TrailingMinusNumbers:=True 

ActiveCell.Columns("A:A").EntireColumn.Select 

Selection.Copy 

Windows("Aggregato.xlsm").Activate 

Sheets("Confronto").Select 

ActiveCell.Columns("A:A").EntireColumn.Select 

ActiveSheet.Paste 

Windows("File.txt").Activate 

ActiveWindow.Close 

'

' COPIA-INCOLLA DA FILE DI LEASYS

'

Workbooks.Open Filename:="C:\Inviati.xlsx" 

ActiveCell.Offset(1, 0).Range("A1").Select 

Range(Selection, Selection.End(xlToRight)).Select 

Range(Selection, Selection.End(xlDown)).Select 

Selection.Copy 

Windows("Aggregato.xlsm").Activate 

Sheets("Report").Select 

ActiveCell.Range("A1").Select 

ActiveSheet.Paste 

Windows("Inviati.xlsx").Activate 

ActiveWindow.Close 

End Sub

Answer 1

Ciao Francesco,

Solo un'ultima domanda e una curiosità.

• La domanda: quando parte la macro "Step_2", correttamente toglie la protezione al foglio e la rimette. Quando la rimette, però, non è più possibile usare i filtri sulla riga 1. C'è un modo per selezionare alcune opzioni quando si reinserisce la password (ecco uno screenshot)?

Sostituisci la procedura Step_2 con la seguente versione, in cui la modifica è evidenziata in verde

'========>>

Option Explicit

'-------->>

Public Sub Step_2()

Dim WB\_Inviati As Workbook, WB\_Testo As Workbook 

Dim SH\_Report As Worksheet, SH\_Confronto As Worksheet 

Dim SH\_Inviati As Worksheet 

Dim Rng\_Inviati As Range 

Dim sPath As String, sSeparatore As String 

Const sPercorso As String = **"C\CARTELLA\" '                    '<<=== Modifica** 

Const sFoglio\_Report As String = **"Report"** 

Const sFoglio\_Confronto As String = **"Confronto"** 

Const sFoglio\_Inviati As String = **"Foglio1"** 

Const sFile\_Inviati As String = **"Inviati"** 

Const sFile\_Testo As String = **"ElencoCartelle.txt"** 

Const sPassword As String = **"Password"                          '<<=== Modifica** 

sSeparatore = Application.PathSeparator 

If Right(sPercorso, 1) = sSeparatore Then 

    sPath = sPercorso 

Else 

    sPath = sPercorso & sSeparatore 

End If 

With ThisWorkbook 

    Set SH\_Report = .Sheets(sFoglio\_Report) 

    Set SH\_Confronto = .Sheets(sFoglio\_Confronto) 

End With 

On Error GoTo XIT 

Application.ScreenUpdating = False 

SH\_Confronto.UsedRange.ClearContents 

SH\_Report.Unprotect Password:=sPassword 

'\\ IMPORTA FILE TXT 

Workbooks.OpenText Filename:=sPath & sFile\_Testo, \_ 

    Origin:=xlWindows, StartRow:=6, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(10, 9), Array(21, 9), Array(36, 1)), TrailingMinusNumbers:=True 

Set WB\_Testo = ActiveWorkbook 

With WB\_Testo 

    .Sheets(1).Columns("A:A").Copy Destination:=SH\_Confronto.Range("A1") 

    .Close SaveChanges:=False 

End With 

'\\ COPIA-INCOLLA DA FILE DI LEASYS 

Set WB\_Inviati = Workbooks.Open(Filename:=sPath & sFile\_Inviati) 

Set SH\_Inviati = WB\_Inviati.Sheets(sFoglio\_Inviati) 

Set Rng\_Inviati = SH\_Inviati.Range("A1").CurrentRegion 

Rng\_Inviati.Copy Destination:=SH\_Report.Range("A1") 

WB\_Inviati.Close SaveChanges:=False 

Call MsgBox(Prompt:="Fatto", Buttons:=vbInformation, Title:="REPORT") 

XIT:

Application.ScreenUpdating = True 

SH\_Report.Protect Password:=sPassword**, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True** 

End Sub

'<<========

• La curiosità: vorrei aggiungere nell'oggetto dell'email (COLONNA J del file "Aggregato") la data (Colonna C del file "Aggregato"). Come posso fare? Ci ho provato più volte ma restituisce sempre il formato tipo 44599...

Nella procedura Step_3, sostituisci l'istruzione:

            .Subject = arrIn(i, 10)

con:

            .Subject = arrIn(i, 10) **& Space(1) & "Data: " & Format(arrIn(i, 3), "dd/mm/yyyy")** 

Nota bene:

Vista la prima richiesta di cui sopra, nella funzione LastRow del modulo di codice Modulo 1, sarà necessario sostituire l'istruzione

      SH.Protect Password:=sPassword, UserInterfaceOnly:=True

con:
SH.Protect Password:=sPassword, UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

===

Regards,

Norman

Answer 2

Grazie mille davvero per il tuo aiuto!

Ho sostituito la macro. Funziona tutto perfettamente ma a patto che tolga manualmente la password al foglio.

C'è un modo per far copia-incollare mantenendo la protezione del foglio?

Le righe di codice interessate sono le seguenti:

'\ COPIA-INCOLLA DA FILE INVIATI

Set WB\_Inviati = Workbooks.Open(Filename:=sPath & sFile\_INVIATI) 

Set SH\_Inviati = WB\_Inviati.Sheets(sFoglio\_Inviati) 

Set Rng\_Inviati = SH\_Inviati.Range("A1").CurrentRegion 

Rng\_Inviati.Copy Destination:=SH\_Report.Range("A1") 

WB\_Inviati.Close SaveChanges:=False 

Call MsgBox(Prompt:="Fatto", Buttons:=vbInformation, Title:="REPORT")

Grazie ancora! :-)

Answer 3

Ciao Francesco,

Ecco qui. La password del foglio Report nel file Aggregato è "Password" :-)

Prova a sostituire la tua procedura Step_2 con la seguente versione:

'========>>

Option Explicit

'-------->>

Public Sub Step_2()

Dim WB\_Inviati As Workbook, WB\_Testo As Workbook 

Dim SH\_Report As Worksheet, SH\_Confronto As Worksheet 

Dim SH\_Inviati As Worksheet 

Dim Rng\_Inviati As Range 

Dim sPath As String, sSeparatore As String 

Const sPercorso As String = **"C:\CARTELLA\"             '<<=== Modifica** 

Const sFoglio\_Report As String = **"Report"** 

Const sFoglio\_Confronto As String = **"Confronto"** 

Const sFoglio\_Inviati As String = **"Foglio1**" 

Const sFile\_Inviati As String = **"Inviati"** 

Const sFile\_Testo As String = **"ElencoCartelle.txt"** 

sSeparatore = Application.PathSeparator 

If Right(sPercorso, 1) = sSeparatore Then 

    sPath = sPercorso 

Else 

    sPath = sPercorso & sSeparatore 

End If 

With ThisWorkbook 

    Set SH\_Report = .Sheets(sFoglio\_Report) 

    Set SH\_Confronto = .Sheets(sFoglio\_Confronto) 

End With 

On Error GoTo XIT 

Application.ScreenUpdating = False 

SH\_Confronto.UsedRange.ClearContents 

'\\ IMPORTA FILE TXT 

Workbooks.OpenText Filename:=sPath & sFile\_Testo, \_ 

    Origin:=xlWindows, StartRow:=6, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(10, 9), Array(21, 9), Array(36, 1)), TrailingMinusNumbers:=True 

Set WB\_Testo = ActiveWorkbook 

With WB\_Testo 

    .Sheets(1).Columns("A:A").Copy Destination:=SH\_Confronto.Range("A1") 

    .Close SaveChanges:=False 

End With 

'\\ COPIA-INCOLLA DA FILE DI LEASYS 

Set WB\_Inviati = Workbooks.Open(Filename:=sPath & sFile\_Inviati) 

Set SH\_Inviati = WB\_Inviati.Sheets(sFoglio\_Inviati) 

Set Rng\_Inviati = SH\_Inviati.Range("A1").CurrentRegion 

Rng\_Inviati.Copy Destination:=SH\_Report.Range("A1") 

WB\_Inviati.Close SaveChanges:=False 

Call MsgBox(Prompt:="Fatto", Buttons:=vbInformation, Title:="REPORT") 

XIT:

Application.ScreenUpdating = True 

End Sub

'<<========

Potresti scaricare ilo mio file di prova Francesco20220720.xlsm

===

Regards,

Norman

Answer 4

Ecco qui. La password del foglio Report nel file Aggregato è "Password" :-)

Answer 5

Ciao Francesco,

Posso usare anche Google Drive?

Sì!

===

Regards,

Norman