Risolto cerca valore su più fogli

[small31]

Buongiorno,
avrei la necessità di creare un comando vba cerca di un valore su più fogli, che mi restituisca tutte le righe intere trovate. allego il file.
il risultato deve comparire sul Foglio 6 del file allegato.
il valore da ricercare è sempre diverso ma contenuto sempre nella colonna A di ogni foglio, quindi avrei pensato ad una test box di ricerca.

GRazie in anticipo

 

[alfrimpa]

S @small31

Fai un esempio concreto del risultato che vuoi ottenere inserendolo a mano.

 

[small31]

perfetto, ho inserito manualmente il risultato che vorrei ottenere, evidenziando con colori diversi in base al file da cui provengono.

 

[alfrimpa]

Scusa S @small31 ma puoi spiegare come viene a determinarsi il risultato atteso in Foglio6?

 

[small31]

Provo a spiegarmi: data un valore variabile, nel mio caso 18-006-00 la macro dovrebbe cercare tale valore in tutti i fogli e riportare sul foglio6 tutte le righe che comprendono tale valore, come nell'esempio evidenziato da me in foglio6

 

[small31]

ho modificato una macro presente in questo forum in questo modo:

Private Sub CommandButton1_Click()
    Dim y As Long
    Dim x As Integer
    Dim uR As Long
    Dim ricerca As String
        With Sheets("base")
        ricerca = InputBox("Scrivi la parola da cercare")
        .Range("A2").EntireRow.Copy Sheets("Risultati").Cells(1, 1)
        For y = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            For x = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
                If UCase(.Cells(y, x)) Like UCase("*" & ricerca & "*") Then
                    uR = Sheets("Risultati").Cells(Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(y, x).EntireRow.Copy
                    Sheets("Risultati").Cells(uR, 1).PasteSpecial Paste:=xlValues
                End If
            Next x
        Next y
    End With
    Application.CutCopyMode = False
End Sub

cosi funziona ma solo su un foglio, vorrei ampliarlo su tutti i fogli presenti, inoltre vorrei che mi tenesse l'intestazione invece con questa macro la cancella e la sostituisce,
Riallego il file con il pulsante macro chiamato RICERCA.

Grazie in anticipo

 

[small31]

allego ultimo file aggiornato, a quanto pare sono riuscita a tenere la riga di intestazione, ora ho bisogno che mi faccia questa ricerca su tutti i fogli.

 

[alfrimpa]

S @small31

Ma perchè sui vari fogli i nomi dei campi (colonne) e posizione sono diversi?

Se fossero uguali sarebbe tutto più semplice.

Riesci a riallegare il file con l'intestazione dei fogli uguale e relativa redistribuzione dei dati?

Non conoscendo il tuo lavoro non posso farlo io.

 

[alfrimpa]

Poi una considerazione.

Io eviterei l'uso di tanti fogli; ne terrei uno solo dove aggiungere un campo (es. Tipo) dove codificherei in base alla tipologia (base, IN LAV etc).

A quel punto probabilmente ti basterebbe un banale filtro (sempre che abbia ben capito l'esigenza).

 

[small31]

AIMè ho la necessita' di avere tutti questi fogli, ho rimodificato tutti fogli con le colonne corrette.
attendo tuo riscontro.

Grazie ancora

 

[small31]

se posso aiutarti in qualche modo posso solo dirti che il dato che è il valore da ricercare è sempre contenuto nella colonna A di tutti i fogli.

 

[alfrimpa]

Si ma se sul foglio4 vedo il campo QUANTITA' mi aspetto di trovarci un numero non un codice (A8014A16)

E perchè questo stesso codice sul foglio IN LAV sta nel campo "Part Number"?

Ripeto per me le intestazioni delle tabelle devono essere uguali e in ogni campo ci deve andare lo stesso tipo di dato.

Poi magari mi sbaglio ma non è così che si strutturano i database.

 

[small31]

Hai perfettamente ragione non fare caso a quello scritto sotto ero un po' di corsa, quel che conta è l'intestazione, e per certo è uguale su tutti i fogli

 

[alfrimpa]

Hai perfettamente ragione non fare caso a quello scritto sotto ero un po' di corsa, quel che conta è l'intestazione, e per certo è uguale su tutti i fogli

Allora, quando potrai riallega il file corretto con le intestazioni giuste e la redistribuzione dei dati corretta.

 

[small31]

HO ALLEGATO IL FILE CORRETTO.
GRAZIE

 

[ges]

Ciao, un saluto a Alfredo
prova così

Option Compare Text
Private Sub CommandButton1_Click()
    Dim y As Long
    Dim x As Integer
    Dim uR As Long
    Dim fg As Integer
    Dim ricerca As String
    ricerca = InputBox("Scrivi la parola da cercare")
    Application.ScreenUpdating = False
    For fg = 1 To Sheets.Count
        If Sheets(fg).Name <> "Risultati" Then
            For y = 2 To Sheets(fg).Cells(Rows.Count, 1).End(xlUp).Row
                For x = 1 To Sheets(fg).Cells(1, Columns.Count).End(xlToLeft).Column
                    If Sheets(fg).Cells(y, x) Like "*" & ricerca & "*" Then
                        uR = Sheets("Risultati").Cells(Rows.Count, 1).End(xlUp).Row + 1
                        Sheets(fg).Cells(y, x).EntireRow.Copy
                        Sheets("Risultati").Cells(uR, 1).PasteSpecial Paste:=xlValues
                    End If
                Next x
            Next y
        End If
    Next fg
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Fai attenzione però che con l'operatore "Like" così come lo hai scritto trovi tutte le righe che contengono la parte ricercata.

 

[small31]

e' perfetta. ora avrei la necessità di selezionare dopo un filtro le celle visibili per poterle tagliare e incollare su altro foglio

 

[small31]

Ciao, un saluto a Alfredo
prova così

Option Compare Text
Private Sub CommandButton1_Click()
    Dim y As Long
    Dim x As Integer
    Dim uR As Long
    Dim fg As Integer
    Dim ricerca As String
    ricerca = InputBox("Scrivi la parola da cercare")
    Application.ScreenUpdating = False
    For fg = 1 To Sheets.Count
        If Sheets(fg).Name <> "Risultati" Then
            For y = 2 To Sheets(fg).Cells(Rows.Count, 1).End(xlUp).Row
                For x = 1 To Sheets(fg).Cells(1, Columns.Count).End(xlToLeft).Column
                    If Sheets(fg).Cells(y, x) Like "*" & ricerca & "*" Then
                        uR = Sheets("Risultati").Cells(Rows.Count, 1).End(xlUp).Row + 1
                        Sheets(fg).Cells(y, x).EntireRow.Copy
                        Sheets("Risultati").Cells(uR, 1).PasteSpecial Paste:=xlValues
                    End If
                Next x
            Next y
        End If
    Next fg
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Fai attenzione però che con l'operatore "Like" così come lo hai scritto trovi tutte le righe che contengono la parte ricercata.

E' perfetta, ti ringrazio tantissimo, ti chiedo solo una cortesia se possibile. si potrebbe inserire in una colonna il nome del foglio da cui provengono le righe? la colonna puo' essere la R
Sarebbe il top!!!
Grazie Mille

 

[small31]

e' perfetta. ora avrei la necessità di selezionare dopo un filtro le celle visibili per poterle tagliare e incollare su altro foglio

non serve più ho risolto cosi:

Private Sub CommandButton1_Click()
Dim ur As Long
Dim lr As Long
Dim rng As Range
Dim cel As Range
Dim r, c, x
ur = Worksheets("RDA").Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Worksheets("RDA").Range("H2:H" & ur)
For Each cel In rng
lr = Worksheets("KIT").Cells(Rows.Count, 1).End(xlUp).Row
    If cel.Value <> 0 Then
        Worksheets("KIT").Cells(lr + 1, 1).Value = cel.Offset(0, -7).Value
        Worksheets("KIT").Cells(lr + 1, 2).Value = cel.Offset(0, -6).Value
        Worksheets("KIT").Cells(lr + 1, 3).Value = cel.Offset(0, -4).Value
        Worksheets("KIT").Cells(lr + 1, 4).Value = cel.Offset(0, -3).Value
        Worksheets("KIT").Cells(lr + 1, 5).Value = cel.Offset(0, -2).Value
        Worksheets("KIT").Cells(lr + 1, 6).Value = cel.Offset(0, -1).Value
        Worksheets("KIT").Cells(lr + 1, 10).Value = cel.Offset(0, 10).Value
        Worksheets("KIT").Cells(lr + 1, 6).Value = cel.Value
    End If
Next cel


r = Cells(Rows.Count, 8).End(xlUp).Row
For x = r To 2 Step -1
    If Cells(x, 8) > 0 Then
        Rows(x & ":" & x).Select
        Selection.Delete Shift:=xlUp
    End If
Next x
End Sub

 

[ges]

ho risolto cosi:

Allora metti RISOLTO alla discussione (se non sai come fare leggi gli Avvisi dello Staff)