Estrapolare Righe solo se...

[Naga]

Ciao a tutti, mi chiamo Marco e sono un nuovo utente, vorrei chiedervi una mano... premesso che prima di creare il nuovo topic ho cercato nel forum ma ho solo trovato cose simili e che sono negato per la programmazione, vi espongo il problema:

Ho creato un file "Archivio.xls" contenente 26 fogli (da A a Z)

in ogni foglio (Lettera) c'è una tabella contenente "CLIENTE |DESCRIZIONE | CODICE | N° FATTURA | IMPORTO"

Ho bisogno di estrarre da ogni foglio tutte le righe contenenti un importo > o = ad un valore X

e se possiblie incolonnarle tutte quante in un altro file "Spesometro.xls"

Spero di essere stato abbastanza chiaro, vi prego ne ho un bisogno pazzesco in quanto mi farebbe risparmiare giorni e giorni di lavoro!!!

Grazie...

PS: Complimenti per il forum ho trovato comunque tante altre cose davvero preziose!!!

[Flash30005]

Ciao Naga e benvenuto nel Forum

Inserisci i due file (Archivio.xls e Spesometro.xls) nella stessa directory
Nel file spesometro (vuoto) hai il Foglio1 e Foglio2
nel foglio1 in A1 inserisci la testata promemoria
'<> DA
In B1 '= A
In A2 digita 0 (zero)
In B2 facoltativo (o qualsiasi valore che vorrai estrarre; questo escluderà chiaramente lo zero).

In un modulo incolla l'intera macro che riporto

Codice: Seleziona tutto

Sub Importadati()
Dim Ws1, Ws2 As Worksheet
Set Ws1 = Worksheets("Foglio1")
Set Ws2 = Worksheets("Foglio2")
NFileOut = ThisWorkbook.Name
Perc = ThisWorkbook.Path
VDiv = Ws1.Range("A2").Value
VUG = Ws1.Range("B2").Value
If VUG = "" Then VUG = -1
UR2 = Ws2.Range("A" & Rows.Count).End(xlUp).Row
If UR2 < 2 Then UR2 = 2
Ws2.Range("A2:E" & UR2).ClearContents
Application.ScreenUpdating = False

 Workbooks.Open Filename:=Perc & "\Archivio.xls"
    Windows("Archivio.xls").Activate
    For F = 1 To Worksheets.Count
        Sheets(F).Select
        Uri = Range("A" & Rows.Count).End(xlUp).Row
        For RRI = 2 To Uri
        If VUG < 0 Then
        If Range("E" & RRI).Value <> VDiv Then
        Range(Cells(RRI, 1), Cells(RRI, 5)).Copy Destination:=Workbooks(NFileOut).Worksheets("Foglio2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If
        Else
        If Range("E" & RRI).Value = VUG Then Range(Cells(RRI, 1), Cells(RRI, 5)).Copy Destination:=Workbooks(NFileOut).Worksheets("Foglio2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If
        Next RRI
    Next F
 Workbooks("Archivio.xls").Close SaveChanges:=False

Application.ScreenUpdating = True


End Sub


Avvia la macro con qualsiasi pulsante oggetto o scelta rapida da tastiera
Avrai il resoconto nel foglio2
(potrai inserire una testata nella riga1 di questo foglio)

Ciao

[Anthony47]

Perdona lo sfogo, ma che senso ha suddividere i dati su 26 fogli, uno per ogni lettera del' alfabeto? Forse la contabilita' si tiene in ordine alfabetico?
Insomma, metti tutto in un unico Foglio, se proprio vuoi aggiungi una colonna iniziale con la "lettera" che vuoi associare a questa riga, e poi usi il filtro automatico che in due click ti presenta i dati che vuoi...
Inoltre su questo database puoi farci comodamente tutti i lavori che servono, da inserire in coda, nell' ordine in cui vengono, le nuove informazioni, ordinare per "lettera", evidenziare gli scaduti non pagati, preparare tabelle pivot di riepilogo, e tutto quello che excel gia' consente avendoci pagato la licenza...

Ciao

[Naga]

Grazie Flash sei un mito!!!

Anthony lo so che non è il massimo in questo modo ma mi è stata richiesta così e l'ho fatta