flo2002
XLDnaute Impliqué
Re à tous!
Grace à votre précieuse aide j'ai une belle macro (à mes yeux) qui marche à premiere vu trés bien (et vous y etes pour quelques choses)
voici la bete:
Sub MAJ_RF()
Cells.Select
Selection.RemoveSubtotal
Range('a1').Select
Sheets('Extract_AFU').Visible = True
Rows(9).Hidden = False
Dim c1 As Range, c2 As Range
Dim Exist As Byte
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets('Rolling_Forecast')
Set ws2 = Sheets('Extract_AFU')
For Each c2 In ws2.Range('w2:w' & ws2.Range('w65536').End(xlUp).Row)
Exist = 0
For Each c1 In ws1.Range('e10:e' & ws1.Range('e65536').End(xlUp).Row)
If c2.Value = c1.Value Then Exist = 1
Next c1
If Exist = 0 Then
With ws1
.Range('e' & .Range('e65536').End(xlUp).Row + 1) = c2
End With
End If
Next c2
Dim derligne1 As Long, derligne2 As Long
Dim derL&
Sheets('Rolling_Forecast').Select
derligne1 = Range('e10').End(xlDown).Row
derligne2 = Range('fw65536').End(xlUp).Row
Range('f9:gc9').Copy
Range(Cells(derligne2, 6), Cells(derligne1, 185)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range('a9:d9').Copy
Range(Cells(10, 1), Cells(derligne1, 4)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows(9).Hidden = True
Range('b10:gc500').Select
Selection.Sort Key1:=Range('e10'), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range('A1').Select
calculate
End Sub
Merci encore!!! :lol:
Grace à votre précieuse aide j'ai une belle macro (à mes yeux) qui marche à premiere vu trés bien (et vous y etes pour quelques choses)
voici la bete:
Sub MAJ_RF()
Cells.Select
Selection.RemoveSubtotal
Range('a1').Select
Sheets('Extract_AFU').Visible = True
Rows(9).Hidden = False
Dim c1 As Range, c2 As Range
Dim Exist As Byte
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets('Rolling_Forecast')
Set ws2 = Sheets('Extract_AFU')
For Each c2 In ws2.Range('w2:w' & ws2.Range('w65536').End(xlUp).Row)
Exist = 0
For Each c1 In ws1.Range('e10:e' & ws1.Range('e65536').End(xlUp).Row)
If c2.Value = c1.Value Then Exist = 1
Next c1
If Exist = 0 Then
With ws1
.Range('e' & .Range('e65536').End(xlUp).Row + 1) = c2
End With
End If
Next c2
Dim derligne1 As Long, derligne2 As Long
Dim derL&
Sheets('Rolling_Forecast').Select
derligne1 = Range('e10').End(xlDown).Row
derligne2 = Range('fw65536').End(xlUp).Row
Range('f9:gc9').Copy
Range(Cells(derligne2, 6), Cells(derligne1, 185)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range('a9:d9').Copy
Range(Cells(10, 1), Cells(derligne1, 4)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows(9).Hidden = True
Range('b10:gc500').Select
Selection.Sort Key1:=Range('e10'), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range('A1').Select
calculate
End Sub
Merci encore!!! :lol: