Ricerca dati in 2 files

[cd7019]

salve,
avrei un problema da porVi:

devo estrarre dei dati da 2 file che si trovano in una directory fissa in un terzo file (RIASSUNTO.XLS).
1° file: dati_parenti.xls
2° file: dati_amici.xls

I 2 FILES hanno delle colonne con intestazione: COGNOME, NOME, INDIRIZZO, CITTA' , ECC...
vorrei estrarre ad esempio tutti i parenti e gli amici che abitano a Torino con tutti i rispettivi dati (parenti/amici, cognome, nome, indirizzo, ecc...) però senza aprile i 2 files. E' possibile?
Quindi solo i dati estratti verranno riportati sul file aperto (RIASSUNTO.XLS).

Grazie.

[Flash30005]

Inserisci in un modulo questa macro e attivala tramite tasto scelta rapida (Ctrl+m)
Inerisci questo file insieme agli altri due (nella stessa cartella senza altri file xls)

Codice: Seleziona tutto

Sub PCF_DP8()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Dim SourceDir As String, ShName As String, I As Long
Range("A2:IV65536").Clear
SourceDir = ThisWorkbook.Path & "\"
MioFile = ThisWorkbook.Name
MioFoglio = ActiveSheet.Name
myCFile = Dir(SourceDir & "\*.xls*")
MiaCitta = Range("K1").Value
Do
    If myCFile = "" Or myCFile = MioFile Then Exit Do
    Workbooks.Open Filename:=SourceDir & myCFile
    Sheets(1).Move Before:=ThisWorkbook.Sheets(1)
    Windows(myCFile).Close savechanges:=False
MySheet = ActiveSheet.Name
URF = Worksheets(MySheet).Range("A" & Rows.Count).End(xlUp).Row
For RRF = URF To 2 Step -1
If Range("D" & RRF).Value <> "Roma" Then Rows(RRF).Delete
Next RRF
URF = Worksheets(MySheet).Range("A" & Rows.Count).End(xlUp).Row
URR = Worksheets(MioFoglio).Range("A" & Rows.Count).End(xlUp).Row + 1
Worksheets(MySheet).Range(Cells(2, 1), Cells(URF, 5)).Copy Destination:=Worksheets(MioFoglio).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Application.DisplayAlerts = False
Worksheets(MySheet).Delete
Application.DisplayAlerts = True

    DoEvents
myCFile = Dir
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


in K1 del foglio (File "Riassunto.xls") inserisci una città
e premi Ctrl+m (tasti scelta rapida)

ciao

N.B. se devi copiare più di 5 colonne (oltre la colonna "E") cambia il valore 5 a questa riga

Codice: Seleziona tutto

Worksheets(MySheet).Range(Cells(2, 1), Cells(URF, 5)).Copy