![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Microsoft 365 e Office | Excel | Per il lavoro | Windows
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione di dati
Ciao,
per questo normalmente si chiede un esempio del risultato desiderato. Spesso una immagine spiega meglio di molte parole.
E conoscere lo scenario può far modificare in modo sostanziale le procedure.
Ti incollo la procedura che in serie fa queste cose.
- cerca di intercettare un file aperto con il nome "ESTRAZIONE.xlsx".
- se non è presente un file aperto con quel nome cerca di aprirlo da un percorso predefinito.
Vedi la constante Const sPercorsoFileEstrazioni As String = "C:\Dropbox\Microsoft Community" (dovrai impostare il tuo percorso badando di chiudere il percorso con la barra separatrice dei percorsi).
- se il file non esiste allora ne viene creato uno nuovo.
Nel caso di file nuovo verrà rinominato il primo foglio e nello stesso vengono inseriti i nominativi e viene effettuata una eliminazione dei nominativi duplicati, inserita la colonna RISPOSTA, applicati i formati ed applicate le varie formattazioni (ho impostato il carattere Calibri con dimensione 10).
Se il file esiste e non è aperto viene aperto e a questo punto viene verificata l'eventuale esistenza di un foglio già nominato con la data di estrazione (il formato del nome è "gg.mm.aa").
Se viene trovato un foglio che ha già il nome di quel giorno della estrazione viene eseguita una cancellazione totale del foglio (istruzione If bFoglioEstrazioneEsiste Then .UsedRange.Clear) e poi vengono eseguite le varie operazioni di inserimento dati, rimozione duplicati, ecc. ecc.
Se il foglio con quel nome non esiste ne viene creato uno nuovo posizionato come primo foglio della cartella di lavoro.
Quindi man mano il primo è il più recente.
Ma volendo si potrebbe spostare il foglio alla fine, anche se con l'aumentare dei fogli, forse è preferibile avere il più recente per primo e il meno recente per ultimo.
Ma se preferisci l'altra soluzione basta modificare questa istruzione:
Set oFoglioEstrazioni = .Worksheets.Add(Before:=Sheets(1))
con
Set oFoglioEstrazioni = .Worksheets.Add(After:=Sheets(Sheets.Count))
ho previsto entrambe le istruzioni e di basta anteporre la virgoletta singola all'istruzione che desideri disabilitare.
Alla fine il file viene salvato e se non era già aperto viene chiuso.
Anche qui ti basta, se non desideri chiudere il file, disabilitare l'istruzione tramite la virgoletta singola.
Questo il codice:
Sub EsportaNomiFornitori()
Const sPercorsoFileEstrazioni As String = "C:\Dropbox\Microsoft Community\"
Const sNomeFileEstrazioni = "ESTRAZIONE.xlsx"
Dim WbEstrazioni As Workbook
Dim bFileEstrazioniAperto As Boolean
Dim bNuovoFileEstrazioni As Boolean
Dim oFoglioEstrazioni As Worksheet
Dim sNomeFoglioEstrazioni As String
Dim bFoglioEstrazioneEsiste As Boolean
Dim rng As Range
Dim UltimaRiga As Long
Application.ScreenUpdating = False
On Error Resume Next
Set WbEstrazioni = Workbooks(sNomeFileEstrazioni)
Err.Clear
If WbEstrazioni Is Nothing Then
Set WbEstrazioni = Workbooks.Open(sPercorsoFileEstrazioni & sNomeFileEstrazioni)
If WbEstrazioni Is Nothing Then
Set WbEstrazioni = Application.Workbooks.Add(xlWBATWorksheet)
bNuovoFileEstrazioni = True
End If
Else
bFileEstrazioniAperto = True
End If
Err.Clear
On Error GoTo GestioneErrori
With ThisWorkbook
Set rng = .Worksheets("righe da sollecitare totali").Columns("B")
End With
UltimaRiga = Application.Max(2, rng.Find(What:="*", _
After:=rng.Cells(1), _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False, _
SearchFormat:=False).Row)
Set rng = rng.Resize(UltimaRiga)
With WbEstrazioni
sNomeFoglioEstrazioni = Format(Date, "dd.mm.yy")
If bNuovoFileEstrazioni Then
Set oFoglioEstrazioni = .Worksheets(1)
oFoglioEstrazioni.Name = sNomeFoglioEstrazioni
.SaveAs sPercorsoFileEstrazioni & sNomeFileEstrazioni, xlWorkbookDefault
Else
On Error Resume Next
bFoglioEstrazioneEsiste = CBool(Len(.Sheets(sNomeFoglioEstrazioni).Name))
Err.Clear
On Error GoTo GestioneErrori
If bFoglioEstrazioneEsiste = False Then
Set oFoglioEstrazioni = .Worksheets.Add(Before:=Sheets(1))
'Set oFoglioEstrazioni = .Worksheets.Add(After:=Sheets(Sheets.Count))
oFoglioEstrazioni.Name = sNomeFoglioEstrazioni
Else
Set oFoglioEstrazioni = .Worksheets(sNomeFoglioEstrazioni)
End If
End If
With oFoglioEstrazioni
If bFoglioEstrazioneEsiste Then .UsedRange.Clear
With .Range("A1")
With .Resize(rng.Rows.Count)
.Value = rng.Value
.Resize(rng.Rows.Count).RemoveDuplicates Columns:=1, Header:=xlYes
.EntireColumn.AutoFit
Set rng = .CurrentRegion
End With
.Value = "FORNITORE"
.Font.Bold = True
.HorizontalAlignment = xlCenter
With .Offset(0, 1)
.Value = "RISPOSTA"
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
With .Resize(rng.Rows.Count, 2)
.Borders.LineStyle = xlContinuous
With .Font
.Size = 10
.Name = "Calibri"
End With
End With
End With
End With
.Save
If bFileEstrazioniAperto = False Then .Close 'chiude il file excel se non era già aperto
End With
RiprendiErrore:
Application.ScreenUpdating = False
Exit Sub
GestioneErrori:
MsgBox "Errore n. " & Err.Number & vbNewLine & _
Err.Description, vbCritical, "Errore VBA"
Resume RiprendiErrore
End Sub
ciao