Risolto Recuperare da un foglio i dati, in un altro foglio tramite elenco a discesa.

Watson

Utente abituale
26 Novembre 2015
107
18
Lombardia
excel 2010
0
Buonasera, vorrei recuperare tutti i dati di un foglio scegliendolo dal foglio RICERCA, vedi esempio scegliendo il foglio 1, mi riporta esattamente 20 righe, se faccio un'altra ricerca scegliendo un altro foglio mi cancella la precedente ricerca.
 

Allegati

dracoscrigno

CioccaPiatti & VBA Expert
Expert
Staff
1 Maggio 2016
4.225
65
Ferrara
office pro 2010
72
Senza aver visto cos' hai scritto visto che il file non lo posso vedere dal cellulare, scommetterei che il motivo del tuo problema è non aver ancora compreso l istruzione che termina con:

qualcosa.End(xlUp)

Che qui dentro, i veterani del "non provo a far niente di nuovo neanche se mi menano"
Solitamente scrivono nella forma:

qualcosa.End(xlUp).row


Cosa dire. Il forum contiene quest istruzione nella STRAmaggioranza dei topic
 

Marius44

VBA Expert
Moderatore
9 Settembre 2015
7.815
145
77
Catania
Excel2010
398
Ciao

dracoscrigno @dracoscrigno
Ottima osservazione. PollicioneInSu
Per rispondere alla tua domanda ti dico che probabilmente è una ridondanza derivante da altri suffissi.
Come ben sai il "qualcosa.End(xlUp)" può essere seguita da .Select se voglio selezionare la cella oppure da .Address se ho bisogno l'indirizzo dell'ultima cella e chissà altri che ora non ricordo. Forse per una maggiore precisione (ma non necessaria in questo contesto) la maggior parte dei programmatori aggiunge .Row.

Ciao,
Mario
 

Marius44

VBA Expert
Moderatore
9 Settembre 2015
7.815
145
77
Catania
Excel2010
398
Ciao
Hai ragione. Non era una domanda "esplicita" ma io l'ho interpretata come tale.
Comunque non mi dici nulla su quanto ho scritto. E' come dico io oppure c'è "qualcos'altro" nascosto? :dubbioso:

Ciao,
Mario
 

Marius44

VBA Expert
Moderatore
9 Settembre 2015
7.815
145
77
Catania
Excel2010
398
Ciao
Torniamo in argomento

W @Watson
Nel file che hai allegato non c'è alcun codice che possa fare quello che dici.
C'è solo una convalida che fa riferimento a quattro celle della col.A (scritte in bianco)

Comunque devi impostare un codice legato all'Evento Change del Foglio Ricerca. Attento che il Change "sente" solo variazioni fisiche sul foglio stesso.

Ciao,
Mario
 

Watson

Utente abituale
26 Novembre 2015
107
18
Lombardia
excel 2010
0
Buongiorno, all'interno del file ci sono 40 fogli, 31 con elenchi , che cosa volevo fare, nel foglio ricerca selezionando uno dei fogli scelto da un elenco a discesa mi riportasse l'elenco del foglio scelto.
Allego file con alcuni fogli.

PS nel file allegato riesco a estrarre solo tutti i fogli.
 

Allegati

giulianovac

Access/VBA Expert
Staff
9 Giugno 2018
5.074
245
Italy
2019
402
Come posso collegare l'elenco a discesa per poter estrarre solo il foglio selezionato?
Devi modificare la tua routine così:

Codice:
Sub ELENCO()

    Dim foglio As Worksheet
    Dim RowRng As Integer

    RowRng = Cells(Rows.Count, 1).End(xlUp).Row
    If RowRng = 1 Then RowRng = 2
    Foglio1.Activate
    Range("A2:G" & RowRng).Clear

    Application.ScreenUpdating = False

    For Each foglio In Worksheets
        ''''If foglio.Name <> "foglio1" Then
        If UCase(foglio.Name) = UCase(Foglio1.Range("N1")) Then
            foglio.Activate
            RowRng = foglio.Cells(Rows.Count, 1).End(xlUp).Row
            foglio.Range("A2:G" & RowRng).Copy
            RowRng = Foglio1.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Foglio1.Range("A" & RowRng).PasteSpecial
            Application.CutCopyMode = False
            Exit For
        End If
    Next foglio

    Application.ScreenUpdating = True
    Foglio1.Activate
    Range("A1").Select

    MsgBox "PROCEDURA ANDATA A BUON FINE", vbInformation, "Procedura VBA Automation"
End Sub
Lascio a te capire le modifiche apportate.
 

Watson

Utente abituale
26 Novembre 2015
107
18
Lombardia
excel 2010
0
Giuliano buon pomeriggio, le modifiche apportate sono perfette, funziona benissimo sul file esempio ma quando le trasferisco sul file originale, modificando i valori non va.
I dati da copiare partono dalla riga 10, i fogli sono numerati "01 lista" ed il foglio di ricerca "foglio30(Ricerca)"

modifiche apportate

Range("A2:G" & RowRng).Clear modificato Range("A10:L" & RowRng).Clear

Foglio1 modificato Foglio30

Dove sbaglio?
 

dracoscrigno

CioccaPiatti & VBA Expert
Expert
Staff
1 Maggio 2016
4.225
65
Ferrara
office pro 2010
72
Avendo:
un worksheet denominato ricerca
un formato tabella in tale foglio, denominato "tabRicerca"
tutti gli altri fogli con la medesima struttura dei dati che comincia dalal cella A2 e, la colonna A, SEMPRE piena di dati:

dovrebbe essere sufficente, nel modulo del worksheet denominato ricerca, scrivere:
ricerca(Ricerca) ha scritto:
Codice:
Private Sub Worksheet_Activate()
    With Me.Cells(1, "I")
        .Value = ""
        With .Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Elenca_fogli
        End With
    End With
    With Me.ListObjects("tabRicerca")
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Cells(1, "I")) Is Nothing Then
        If Target.Rows.Count + Target.Columns.Count = 2 Then
            If Target.Value <> "" Then
                With Me.ListObjects("tabRicerca")
                    If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
                End With
                With Worksheets(Target.Value)
                    Set corpo = .Range(.Cells(2, "A").End(xlDown), .Cells(2, 7))
                    Me.ListObjects("tabRicerca").HeaderRowRange.Cells(1).Offset(1).Resize(corpo.Rows.Count, corpo.Columns.Count) = corpo.Value
                End With
            End If
        End If
    End If
End Sub

Private Function Elenca_fogli() As String
    For Each foglio In ThisWorkbook.Worksheets
        If Not foglio Is Me Then
            uscita = uscita & foglio.Name & ","
        End If
    Next
    Elenca_fogli = Left(uscita, Len(uscita) - 1)
End Function
nel momento in cui si accede al foglio, accade:
viene cancellato il contenuto della tabella
  • viene cancellato il contenuto della cella I1
  • viene cancelalta e ricreata la validazione in cella I1

nel momento in cui si effettua una scelta in celal I1 accade:
  • viene eleiminato il corpo dei dati dalal tabella
  • viene ricreato con i dati del foglio selezionato in celal I1
 
Ultima modifica:

giulianovac

Access/VBA Expert
Staff
9 Giugno 2018
5.074
245
Italy
2019
402
la macro non è stata modificata.
Devi modificare TUTTI i riferimenti (righe e celle)
Basta fare un po' di DEBUG passo-passo (1) per capire come fare la modifica, almeno quello dovresti farlo tu.
Dai, un po' di iniziativa non guasta, se non altro per imparare (perché è dagli errori che si impara!)

Ad esempio:
A) che senso ha 'pulire' questa area:
Range("A2:L" & RowRng).Clear
quando in L2 hai il filtro con il nome del foglio (*)????? TestateSulMuro

B) Che nome ha il foglio RICERCA ?

(*) che quindi verrà cancellato e non funziona più nulla... Muoio_muoio
(1) se non sai come fare leggi i link nella mia firma.
 

E. Santamato

Utente abituale
26 Gennaio 2020
317
30
Milano
2010
31
Buongiorno W @Watson e forum
Un possibile sviluppo che punta sulla velocità
Visual Basic:
Sub ELENCO()
Dim foglio As Worksheet
Dim oShtRicerca As Worksheet, oShtOrigine As Worksheet
Dim RowRng As Integer, iRngRighe As Integer
Set oShtRicerca = ActiveWorkbook.Sheets("Ricerca")
Set oShtOrigine = ActiveWorkbook.Sheets(oShtRicerca.Range("N1").Value)
With oShtRicerca
  iRngRighe = .Range("A1").CurrentRegion.Rows.Count
  If iRngRighe > 1 Then Rows("2:" & iRngRighe).Delete Shift:=xlUp
  iRngRighe = oShtOrigine.Range("A1").CurrentRegion.Rows.Count
  oShtOrigine.Range("A2:G" & iRngRighe).Copy Destination:=.Range("A2")
End With 'oShtRicerca
GoTo UscitaDallaSub:

'
RowRng = Cells(Rows.Count, 1).End(xlUp).Row
If RowRng = 1 Then RowRng = 2
Foglio1.Activate
Range("A2:G" & RowRng).Clear

Application.ScreenUpdating = False

For Each foglio In Worksheets
        If foglio.Name <> "foglio1" Then
            foglio.Activate
                RowRng = Cells(Rows.Count, 1).End(xlUp).Row
            Range("A2:G" & RowRng).Copy
                RowRng = Foglio1.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Foglio1.Range("A" & RowRng).PasteSpecial
            Application.CutCopyMode = False
         End If
Next foglio
'
Application.ScreenUpdating = True
Foglio1.Activate
Range("A1").Select

UscitaDallaSub:
Set oShtRicerca = Nothing
Set oShtOrigine = Nothing
MsgBox "PROCEDURA ANDATA A BUON FINE", vbInformation, "Procedura VBA Automation"
End Sub
L'Enzo
 

Allegati

Watson

Utente abituale
26 Novembre 2015
107
18
Lombardia
excel 2010
0
la macro non è stata modificata.
Devi modificare TUTTI i riferimenti (righe e celle)
Basta fare un po' di DEBUG passo-passo (1) per capire come fare la modifica, almeno quello dovresti farlo tu.
Dai, un po' di iniziativa non guasta, se non altro per imparare (perché è dagli errori che si impara!)

Ad esempio:
A) che senso ha 'pulire' questa area:
Range("A2:L" & RowRng).Clear
quando in L2 hai il filtro con il nome del foglio (*)????? TestateSulMuro

B) Che nome ha il foglio RICERCA ?

(*) che quindi verrà cancellato e non funziona più nulla... Muoio_muoio
(1) se non sai come fare leggi i link nella mia firma.

Giuliano buongiorno, ti ringrazio per i link , vediamo se ci salto fuori .... benedetta età!!!
 

Watson

Utente abituale
26 Novembre 2015
107
18
Lombardia
excel 2010
0
Buongiorno W @Watson e forum
Un possibile sviluppo che punta sulla velocità
Visual Basic:
Sub ELENCO()
Dim foglio As Worksheet
Dim oShtRicerca As Worksheet, oShtOrigine As Worksheet
Dim RowRng As Integer, iRngRighe As Integer
Set oShtRicerca = ActiveWorkbook.Sheets("Ricerca")
Set oShtOrigine = ActiveWorkbook.Sheets(oShtRicerca.Range("N1").Value)
With oShtRicerca
  iRngRighe = .Range("A1").CurrentRegion.Rows.Count
  If iRngRighe > 1 Then Rows("2:" & iRngRighe).Delete Shift:=xlUp
  iRngRighe = oShtOrigine.Range("A1").CurrentRegion.Rows.Count
  oShtOrigine.Range("A2:G" & iRngRighe).Copy Destination:=.Range("A2")
End With 'oShtRicerca
GoTo UscitaDallaSub:

'
RowRng = Cells(Rows.Count, 1).End(xlUp).Row
If RowRng = 1 Then RowRng = 2
Foglio1.Activate
Range("A2:G" & RowRng).Clear

Application.ScreenUpdating = False

For Each foglio In Worksheets
        If foglio.Name <> "foglio1" Then
            foglio.Activate
                RowRng = Cells(Rows.Count, 1).End(xlUp).Row
            Range("A2:G" & RowRng).Copy
                RowRng = Foglio1.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Foglio1.Range("A" & RowRng).PasteSpecial
            Application.CutCopyMode = False
         End If
Next foglio
'
Application.ScreenUpdating = True
Foglio1.Activate
Range("A1").Select

UscitaDallaSub:
Set oShtRicerca = Nothing
Set oShtOrigine = Nothing
MsgBox "PROCEDURA ANDATA A BUON FINE", vbInformation, "Procedura VBA Automation"
End Sub
L'Enzo

Salve Santamato, così abbiamo eliminato il click su estrazione accelerando la procedura.

Il problema rimane nell'esempio "elenco3", perché spostando nel foglio RICERCA l'elenco dalla prima riga alla sesta e nei fogli 01 foglio, 02 foglio, ecc. partendo dalla decima riga e li mi sono incasinato.
Giustamente Giuliano, mi ha suggerito di dare un occhiata ad alcuni link per avere le idee più chiare.
Grazie per la modifica apportata.
 

E. Santamato

Utente abituale
26 Gennaio 2020
317
30
Milano
2010
31
Buongiorno W @Watson e forum
In effetti mi sembrava troppo semplice; quindi ad ogni selezione di fogli in N1 con i dati da importare, quest'ultimi vanno accodati. Mi mancava questa condizione.
Se fosse così, ecco la rettifica.
Visual Basic:
Sub ELENCO()
Dim foglio As Worksheet
Dim oShtRicerca As Worksheet, oShtOrigine As Worksheet
Dim RowRng As Integer, iRngRighe As Integer, iRigheRicerca As Integer
Application.EnableEvents = False
Set oShtRicerca = ActiveWorkbook.Sheets("Ricerca")
iRigheRicerca = oShtRicerca.Range("A1").CurrentRegion.Rows.Count
Set oShtOrigine = ActiveWorkbook.Sheets(oShtRicerca.Range("N1").Value)
With oShtRicerca
'  iRngRighe = .Range("A1").CurrentRegion.Rows.Count
'  If iRngRighe > 1 Then Rows("2:" & iRngRighe).Delete Shift:=xlUp
  iRngRighe = oShtOrigine.Range("A1").CurrentRegion.Rows.Count
  oShtOrigine.Range("A2:G" & iRngRighe).Copy Destination:=.Range("A" & iRigheRicerca + 1)
End With 'oShtRicerca
GoTo UscitaDallaSub:

'
RowRng = Cells(Rows.Count, 1).End(xlUp).Row
If RowRng = 1 Then RowRng = 2
Foglio1.Activate
Range("A2:G" & RowRng).Clear

Application.ScreenUpdating = False

For Each foglio In Worksheets
        If foglio.Name <> "foglio1" Then
            foglio.Activate
                RowRng = Cells(Rows.Count, 1).End(xlUp).Row
            Range("A2:G" & RowRng).Copy
                RowRng = Foglio1.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Foglio1.Range("A" & RowRng).PasteSpecial
            Application.CutCopyMode = False
         End If
Next foglio
'
Application.ScreenUpdating = True
Foglio1.Activate
Range("A1").Select

UscitaDallaSub:
Application.EnableEvents = True
Set oShtRicerca = Nothing
Set oShtOrigine = Nothing
MsgBox "PROCEDURA ANDATA A BUON FINE", vbInformation, "Procedura VBA Automation"
End Sub
Non ho cancellato il codice nativo e lo lasciato in linea.
Spero d'aver capito il problema
L'Enzo
 

Allegati

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!