- Codice: Seleziona tutto
Sub copiaFile()
Dim WK1 As Workbook
Dim WK2 As Workbook
Dim xOut As Worksheet
Dim xWk As Worksheet
Dim x As Long
Dim uR As Long
Dim i As Long
Dim FileAltro
Application.ScreenUpdating = False
FileAltro = Application.GetOpenFilename
If FileAltro = "Falso" Then
MsgBox "Operazione annullata!", vbOKOnly + vbInformation
GoTo chiudi
End If
Set WK1 = ThisWorkbook
Set WK2 = Workbooks.Open(FileAltro)
Set xOut = WK1.Worksheets(1)
With xOut
.Cells(1, 1) = "Nome"
.Cells(1, 2) = "Istituto"
.Cells(1, 3) = "Orario Inizio"
.Cells(1, 4) = "Orario Fine"
x = 2
For Each xWk In WK2.Worksheets
uR = xWk.Cells(Rows.Count, 2).End(xlUp).Row
[color=#FF0000] For i = 1 To uR[/color]
[color=#FF0000] If xWk.Cells(i, 2) = "PERMESSO" Then[/color]
xOut.Cells(x, 1) = xWk.Name
xOut.Cells(x, 2) = xWk.Cells(i, 2)
xOut.Cells(x, 3) = xWk.Cells(i, 3)
xOut.Cells(x, 4) = xWk.Cells(i, 4)
x = x + 1
End If
Next
Next
WK2.Close SaveChanges:=False
.Columns("A:D").EntireColumn.AutoFit
End With
chiudi:
Set WK1 = Nothing
Set WK2 = Nothing
Set xOut = Nothing
Set xWk = Nothing
Application.ScreenUpdating = True
End Sub
ora però vorrei modificarla per poter ricercare tutti i valori presenti nella colonna 2 dalla riga 10.....
ho provato a cambiare la parte che ho evidenziato tra "color" con
For i = 10 To uR
- Codice: Seleziona tutto
[color=#FF0000] If xWk.Cells(i, 2) = "<>" Then[/color]
ma non va....dove sbaglio?
grazie
