- Codice: Seleziona tutto
Sub VEDIMACCHINA_1()
'ISTRUZIONI PER PULIRE CELLE E POTER COPIARE LA NUOVA LISTA DI PRODUZIONE
Worksheets("1").Activate
For RIGA = 2 To 50
If Cells(RIGA, 17) = "TERMINATO" Then
Cells(RIGA, 1).ClearContents
Cells(RIGA, 2).ClearContents
Cells(RIGA, 3).ClearContents
Cells(RIGA, 4).ClearContents
Cells(RIGA, 5).ClearContents
Cells(RIGA, 6).ClearContents
Cells(RIGA, 7).ClearContents
Cells(RIGA, 8).ClearContents
Cells(RIGA, 9).ClearContents
Cells(RIGA, 10).ClearContents
Cells(RIGA, 11).ClearContents
Cells(RIGA, 17).ClearContents
End If
Next
'ISTRUZIONI PER TROVARE IL NUMERO DELLA MACCHINA E COPIARE LA RIGA
Dim i As Integer 'VALORE NUMERICO NEGATIVO
Dim ur As Long 'VALORE NUMERICO
Dim lr As Long 'VALORE NUMERICO
Dim rng As Range 'rgn VERRA' CONSIDERATO COME UN RANGE
Dim cel As Range
'IL PROBLEMA DOVREBBE TROVARSI QUI!!
ur = Worksheets("Foglio2").Cells(Rows.Count, "S").End(xlUp).Row 'CONTARIGHE PIENE NELLA COLONNA S
Set rng = Worksheets("Foglio2").Range("S2:S" & ur) 'rng COMPRESO TRA S2 E L'ULTIMA CELLA IN S PIENA
For Each cel In rng 'PER OGNI CELLA NEL NOSTRO rng
lr = Worksheets("1").Cells(Rows.Count, "A").End(xlUp).Row 'CONTARIGHE PER LA TABELLA DOVE VERRANNO IMPORTATI I DATI
If cel.Value = "1" Then 'SE IL VALORE DELLA CELLA CONTENUTA NEL rng E' 1
For i = -18 To -8 'IMPOSTATO NEGATIVO DA -18 A -9 PER POTER LAVORARE CON L'OFFSET DELLA CELLA S CONTENENTE X1
Worksheets("1").Cells(lr + 1, i + 19).Value = cel.Offset(0, i).Value
Next i
End If
Next cel
'ISTRUZIONE PER ELIMINARE DUPLICATI
Application.ScreenUpdating = False
Range("A2:Q50").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Set currentCell = Worksheets("1").Range("B2")
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(1, 0)
If nextCell.Value = currentCell.Value Then
For f = 0 To 9
currentCell.Offset(0, f).ClearContents
currentCell.Offset(0, -1).ClearContents
Next
End If
Set currentCell = nextCell
Loop
Range("B2").Select
'ISTRUZIONI PER METTERE I CODICI IN ORDINE
Application.ScreenUpdating = False
Range("A2:Q50").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub