1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
| Sub PrepaAcces2()
Dim DerLtabl As Long, derLigne As Long, NbCol As Long, i As Long, j As Long, k As Long
DerLtabl = Cells(Range("A:A").Rows.Count, 1).End(xlUp).Row 'détermine la derière ligne pour la sélection à copier
NbCol = Cells(1, Range("1:1").Columns.Count).End(xlToLeft).Column 'détermine le nombre de colonne
For j = 2 To DerLtabl
For i = 9 To NbCol Step 3
If Not IsEmpty(Cells(j, i).Value) Then
derLigne = Sheets("Cible").Cells(Range("I:I").Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(j, 1), Cells(j, 8)).Copy Destination:=Sheets("Cible").Cells(derLigne, 1)
Range(Cells(j, i), Cells(j, i + 2)).Copy Destination:=Sheets("Cible").Cells(derLigne, 9)
End If
Next i
Next j
Sheets("Cible").Select
With Worksheets("Cible")
.Cells(1, 1).Value = "Studio"
.Cells(1, 2).Value = "Code Client"
.Cells(1, 3).Value = "Agence"
.Cells(1, 4).Value = "Nom"
.Cells(1, 5).Value = "Caution"
.Cells(1, 6).Value = "Date entrée"
.Cells(1, 7).Value = "Date Sortie"
.Cells(1, 8).Value = "Loyer"
.Cells(1, 9).Value = "Montant"
.Cells(1, 10).Value = "Extrait"
.Cells(1, 11).Value = "Mois"
End With
Selection.Font.Bold = True
Range("I1:j1").Select
With Selection.Font
.Color = -11489280
.TintAndShade = 0
End With
Selection.Font.Bold = True
Range("A1:H1").Select
Selection.Font.Bold = True
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = -1
End With
Range("a1:k1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub |
Partager