PMG
XLDnaute Junior
Bonjour Le fil, le forum,
Pourriez vous m'aider à corriger ma macro svp.
Je dois transférer des "dates féries" d'un tableau que si elles ne sont pas comprises dans les "dates congés" vers un tableau résultat. La macro marche presque (je m'améliore) mais j'ai des erreurs:
Je précise que c'est seulement la première colonne du tableau d'origine qui sert de référence (pas la deuxième qui sert à des calculs).
Problème 1:
La déclaration de mon tableau origine si la ligne du dessous n'est pas vide.
Problème 2:
La mise en forme est décalée ds le tableau résultat.
Merci bcp d'avance pour votre disponibilité.
PMG
Pourriez vous m'aider à corriger ma macro svp.
Je dois transférer des "dates féries" d'un tableau que si elles ne sont pas comprises dans les "dates congés" vers un tableau résultat. La macro marche presque (je m'améliore) mais j'ai des erreurs:
Je précise que c'est seulement la première colonne du tableau d'origine qui sert de référence (pas la deuxième qui sert à des calculs).
Problème 1:
La déclaration de mon tableau origine si la ligne du dessous n'est pas vide.
Problème 2:
La mise en forme est décalée ds le tableau résultat.
Merci bcp d'avance pour votre disponibilité.
PMG
VB:
Sub M_Calendrier_Transfert_Feries()
Dim ws_BD2 As Worksheet, ws_BD3 As Worksheet
Dim tablo_origine(), tablo_resultat(), Dte As Long, Lgn As Byte, x As Integer, Derlgn As Byte
Dim FirstDate As Long, LastDate As Long
'-----Transfert des feriés sans doublons avec les congés (BD2 vers BD3) -----'
Application.ScreenUpdating = False
Set ws_BD2 = Sheets("BD2")
Set ws_BD3 = Sheets("BD3")
'tablo_origine = ws_BD2.Range("D6:E19")
With ws_BD2
Derlgn = .Cells(20, "E").End(xlUp).Row
tablo_origine = .Range(.Cells(6, "D"), .Cells(Derlgn, "E")).Value
End With
x = 0
For Lgn = 1 To UBound(tablo_origine, 1)
FirstDate = DateValue(tablo_origine(Lgn, 1)): LastDate = DateValue(tablo_origine(Lgn, 2))
For Dte = FirstDate To LastDate Step 1
If IsError(Application.Match(Dte, [BD3_Congés], 0)) Then
Select Case True
Case Dte = FirstDate
x = x + 1
ReDim Preserve tablo_resultat(2, x)
tablo_resultat(1, x) = Format(Dte, "mm/dd/yy hh:mm")
tablo_resultat(2, x) = Format(Dte, "mm/dd/yy hh:mm")
End Select
End If
Next Dte
Next Lgn
With ws_BD3
.Range("D6:E19").ClearContents
.Cells(6, "D").Resize(UBound(tablo_resultat, 2), UBound(tablo_resultat, 1)) = Application.Transpose(tablo_resultat)
End With
End Sub