Sub macro2()
Dim TabData() As Variant
Dim TabFinal() As Variant
Dim Tab1() As Variant
Dim Tab2() As Variant
With Sheets("BDD")
Nbl = .Range("B" & .Rows.Count).End(xlUp).Row - 3
TabData = .Range("B4:E" & Nbl + 3).Value
ReDim TabFinal(1 To 2 * Nbl, 1 To 4)
End With
With Sheets("Tableaux")
.Range("Tableau1").ClearContents
.Range("Tableau2").ClearContents
Tab1 = .Range("Tableau1").Value
Tab2 = .Range("Tableau2").Value
End With
For i = LBound(TabData, 1) To UBound(TabData, 1)
'MsgBox UBound(TabFinal, 1)
TabFinal(i, 1) = TabData(i, 1)
TabFinal(i + Nbl, 1) = TabData(i, 4)
TabFinal(i, 4) = TabData(i, 2)
TabFinal(i + Nbl, 4) = TabData(i, 3)
Next i
For i = LBound(TabFinal, 1) To UBound(TabFinal, 1)
If i <= 15 Then
For j = 1 To 4
Tab1(i, j) = TabFinal(i, j)
Next j
Else
For j = 1 To 4
Tab2(i - 15, j) = TabFinal(i, j)
Next j
End If
Next i
With Sheets("Tableaux")
.Range("Tableau1") = Tab1
.Range("Tableau2") = Tab2
End With
End Sub
Sub Macro1()
Dim Col1 As Range, Col2 As Range, Col3 As Range, Col4 As Range
Dim F As Worksheet, i As Byte, T As Range, h As Long
Set Col1 = [masj]: Set Col2 = [pj] 'plages nommées
Set Col3 = [soir]: Set Col4 = [psoir] 'plages nommées
Application.ScreenUpdating = False
Set F = Workbooks.Add.Sheets(1) 'document auxiliaire
Col1.Copy F.[A1]
Col3.Copy F.Range("A" & F.Rows.Count).End(xlUp)(2)
Set Col1 = F.[A:A] 'redéfinition
Col2.Copy F.[B1]
Col4.Copy F.Range("B" & F.Rows.Count).End(xlUp)(2)
Set Col2 = F.[B:B] 'redéfinition
With Feuil2 'CodeName de la feuille
For i = 1 To 2 '2 tableaux nommés
Set T = .Range("Tableau" & i)
T.Columns(1) = Col1.Resize(T.Rows.Count).Offset(h).Value 'copie les valeurs
T.Columns(4) = Col2.Resize(T.Rows.Count).Offset(h).Value 'copie les valeurs
h = h + T.Rows.Count
If Application.CountA(T) Then
.PageSetup.PrintArea = T.EntireColumn _
.Resize(T.EntireColumn.Find("*", , xlValues, , xlByRows, xlPrevious).Row).Address
.PrintPreview 'aperçu avant impression pour tester
'.PrintOut 'pour imprimer
End If
Next
End With
F.Parent.Close False 'fermeture du document auxiliaire
End Sub
Sub macro2()
Dim Col1 As Range, Col2 As Range, Col11 As Range, Col12 As Range
Dim F As Worksheet, i As Byte, T As Range, h As Long
Set Col1 = [masj]: Set Col2 = [pjour] 'plages nommées
Set Col11 = [soir]: Set Col12 = [psoir] 'plages nommées
Application.ScreenUpdating = False
Set F = Workbooks.Add.Sheets(1) 'document auxiliaire
Col1.Copy F.[A1]
Col11.Copy F.Range("A" & F.Rows.Count).End(xlUp)(2)
Set Col1 = F.Range("A1", F.Range("A" & F.Rows.Count).End(xlUp)) 'redéfinition
Col2.Copy F.[B1]
Col12.Copy F.Range("B" & F.Rows.Count).End(xlUp)(2)
Set Col2 = F.Range("B1", F.Range("B" & F.Rows.Count).End(xlUp)) 'redéfinition
With Feuil4 'CodeName de la feuille
.Activate
For i = 1 To 2 '2 tableaux nommés
Set T = .Range("Tableau" & i)
T.Columns(1) = Col1.Offset(h).Resize(T.Rows.Count).Value 'copie les valeurs
T.Columns(4) = Col2.Offset(h).Resize(T.Rows.Count).Value 'copie les valeurs
h = h + T.Rows.Count
If Application.CountA(T.Columns(1), T.Columns(4)) Then
.PageSetup.PrintArea = T.EntireColumn.Resize(Union(T.Columns(1), T.Columns(4)) _
.EntireColumn.Find("*", , xlValues, , xlByRows, xlPrevious).Row).Address
.PrintPreview 'aperçu avant impression pour tester
'.PrintOut 'pour imprimer
End If
Next
F.Parent.Close False 'fermeture du document auxiliaire
End With
End Sub