Comment modifier la macro ci dessous pour que lors de l’exécution 3 lignes du tableur arrivent sur la mème feuille etc etc ..
Help ???
Sub parse_data()
Dim xRCount As Long
Dim xSht As Worksheet
Dim xNSht As Worksheet
Dim I As Long
Dim xTRrow As Integer
Dim xCol As New Collection
Dim xTitle As String
Dim xSUpdate As Boolean
Set xSht = ActiveSheet
On Error Resume Next
xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
xTRrow = xSht.Range("A4").Cells(1).Row
For I = 4 To xRCount
Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text)
Next
xSUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To xCol.Count
Set xNSht = Nothing
Set xNSht = Worksheets(CStr(xCol.Item(I)))
If xNSht Is Nothing Then
Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
xNSht.Name = CStr(xCol.Item(I))
With xNSht.Range("B12:I32")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.Font.Size = 24
.MergeCells = True
End With
With xNSht.Range("B35:I42")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.Font.Size = 24
.MergeCells = True
End With
xSht.Range("A" & I + 3).Copy xNSht.Range("B12:I32")
xSht.Range("B" & I + 3).Copy xNSht.Range("B35:I42")
Else
xNSht.Move , Sheets(Sheets.Count)
End If
Next
xSht.AutoFilterMode = False
xSht.Activate
Application.ScreenUpdating = xSUpdate
End Sub