| | Post: 3.549 | Registrato il: 06/04/2013
| Utente Master | 2010 | | OFFLINE |
|
04/10/2023 18:31 | |
ciao Melissa
quindi a quanto pare il tuo file contiene diversi fogli - formule e (forse) anche eventi del foglio interessato.
Fai questa prova sfruttando gli array e vedi che succede.
Fai sapere....un caro saluto
Sub INCOLONNAMENTO()
Dim mArrF() As Variant, mArrTo() As Variant, lr As Long, k As Long, indx As Long, c As Byte
Dim I As Long, s As Boolean
On Error GoTo merr
Sheets("INCOLONNAMENTO CON MACRO").Select
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
lr = Range("A" & Rows.Count).End(xlUp).Row
mArrF = Range("A3:C23")
k = 2
ReDim mArrTo(1 To lr, 1 To 3)
For c = 1 To 3
mArrTo(1, c) = mArrF(1, c)
Next c
Range("E3:G10000").ClearContents
indx = 2
For I = 4 To lr
If mArrF(indx, 1) > mArrTo(k - 1, 1) Then
For c = 1 To 3
mArrTo(k, c) = mArrF(indx, c)
mArrTo(k, c) = mArrF(indx, c)
Next c
s = True
End If
If mArrF(indx, 2) - mArrF(k - 1, 2) >= Cells(1, 7) Then
For c = 1 To 3
mArrTo(k, c) = mArrF(indx, c)
mArrTo(k, c) = mArrF(indx, c)
Next c
s = True
End If
indx = indx + 1
If s Then
k = k + 1
s = False
End If
Next I
Range("E3").Resize(lr, 3) = mArrTo
xit:
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
Exit Sub
merr:
MsgBox Err.Number & " _ " & Err.Description
Resume xit
End Sub Domenico
Win 10 - Excel 2016 |
|
|