Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichD
Bonjour,
Essaie ceci :
'----------------------------------------------------------------------- Sub test() Dim Rg As Range, C As Range, T() Dim A As Long, B As Long, D As Long
With Worksheets("CollerWeb") Set Rg = .Range("A2:D" & .Range("A" & .Rows.Count).End(xlUp).Row) End With
ReDim T(1 To Rg.Rows.Count, 1 To 4)
For A = 1 To Rg.Rows.Count D = D + 1 For B = 1 To Rg.Columns.Count Select Case B Case 1, 2 T(D, B) = Rg(A, B) Case 3 T(D, 3) = CDbl(Replace(Rg(A + 1, 2), " EUR", "")) Case 4 T(D, 4) = Rg(A + 1, 4) End Select Next A = A + 1 Next
'Où tu veux avoir tes données, Adapte le nom de la feuille 'et l'adresse de la cellule de départ With Worksheets("Extrations") With .Range("G1").Resize(UBound(T, 1), UBound(T, 2)) .Value = T .Offset(, 2).Resize(.Rows.Count, 1).NumberFormat = "# ##0.00" End With End With End Sub '-----------------------------------------------------------------------
Bonjour,
Essaie ceci :
'-----------------------------------------------------------------------
Sub test()
Dim Rg As Range, C As Range, T()
Dim A As Long, B As Long, D As Long
With Worksheets("CollerWeb")
Set Rg = .Range("A2:D" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
ReDim T(1 To Rg.Rows.Count, 1 To 4)
For A = 1 To Rg.Rows.Count
D = D + 1
For B = 1 To Rg.Columns.Count
Select Case B
Case 1, 2
T(D, B) = Rg(A, B)
Case 3
T(D, 3) = CDbl(Replace(Rg(A + 1, 2), " EUR", ""))
Case 4
T(D, 4) = Rg(A + 1, 4)
End Select
Next
A = A + 1
Next
'Où tu veux avoir tes données, Adapte le nom de la feuille
'et l'adresse de la cellule de départ
With Worksheets("Extrations")
With .Range("G1").Resize(UBound(T, 1), UBound(T, 2))
.Value = T
.Offset(, 2).Resize(.Rows.Count, 1).NumberFormat = "# ##0.00"
End With
End With
End Sub
'-----------------------------------------------------------------------
'----------------------------------------------------------------------- Sub test() Dim Rg As Range, C As Range, T() Dim A As Long, B As Long, D As Long
With Worksheets("CollerWeb") Set Rg = .Range("A2:D" & .Range("A" & .Rows.Count).End(xlUp).Row) End With
ReDim T(1 To Rg.Rows.Count, 1 To 4)
For A = 1 To Rg.Rows.Count D = D + 1 For B = 1 To Rg.Columns.Count Select Case B Case 1, 2 T(D, B) = Rg(A, B) Case 3 T(D, 3) = CDbl(Replace(Rg(A + 1, 2), " EUR", "")) Case 4 T(D, 4) = Rg(A + 1, 4) End Select Next A = A + 1 Next
'Où tu veux avoir tes données, Adapte le nom de la feuille 'et l'adresse de la cellule de départ With Worksheets("Extrations") With .Range("G1").Resize(UBound(T, 1), UBound(T, 2)) .Value = T .Offset(, 2).Resize(.Rows.Count, 1).NumberFormat = "# ##0.00" End With End With End Sub '-----------------------------------------------------------------------
MichD
Pour tenir compte des en-têtes de colonnes :
Sub test() Dim Rg As Range, C As Range, T() Dim A As Long, B As Long, D As Long Dim Arr() Arr = Array("Date", "Libellé", "Montant", "Mois")
With Worksheets("CollerWeb") Set Rg = .Range("A2:D" & .Range("A" & .Rows.Count).End(xlUp).Row) End With
ReDim T(1 To Rg.Rows.Count, 1 To 4)
For A = 1 To Rg.Rows.Count D = D + 1 For B = 1 To Rg.Columns.Count Select Case B Case 1, 2 T(D, B) = Rg(A, B) Case 3 T(D, 3) = CDbl(Replace(Rg(A + 1, 2), " EUR", "")) Case 4 T(D, 4) = Rg(A + 1, 4) End Select Next A = A + 1 Next
'Où tu veux avoir tes données, Adapte le nom de la feuille 'et l'adresse de la cellule de départ With Worksheets("Extrations") With .Range("G1").Resize(UBound(T, 1), UBound(T, 2)) .Value = Application.Transpose(Arr) .Offset(1).Value = T .Offset(, 2).Resize(.Rows.Count, 1).NumberFormat = "# ##0.00" .EntireColumn.AutoFit End With End With End Sub
Pour tenir compte des en-têtes de colonnes :
Sub test()
Dim Rg As Range, C As Range, T()
Dim A As Long, B As Long, D As Long
Dim Arr()
Arr = Array("Date", "Libellé", "Montant", "Mois")
With Worksheets("CollerWeb")
Set Rg = .Range("A2:D" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
ReDim T(1 To Rg.Rows.Count, 1 To 4)
For A = 1 To Rg.Rows.Count
D = D + 1
For B = 1 To Rg.Columns.Count
Select Case B
Case 1, 2
T(D, B) = Rg(A, B)
Case 3
T(D, 3) = CDbl(Replace(Rg(A + 1, 2), " EUR", ""))
Case 4
T(D, 4) = Rg(A + 1, 4)
End Select
Next
A = A + 1
Next
'Où tu veux avoir tes données, Adapte le nom de la feuille
'et l'adresse de la cellule de départ
With Worksheets("Extrations")
With .Range("G1").Resize(UBound(T, 1), UBound(T, 2))
.Value = Application.Transpose(Arr)
.Offset(1).Value = T
.Offset(, 2).Resize(.Rows.Count, 1).NumberFormat = "# ##0.00"
.EntireColumn.AutoFit
End With
End With
End Sub
Sub test() Dim Rg As Range, C As Range, T() Dim A As Long, B As Long, D As Long Dim Arr() Arr = Array("Date", "Libellé", "Montant", "Mois")
With Worksheets("CollerWeb") Set Rg = .Range("A2:D" & .Range("A" & .Rows.Count).End(xlUp).Row) End With
ReDim T(1 To Rg.Rows.Count, 1 To 4)
For A = 1 To Rg.Rows.Count D = D + 1 For B = 1 To Rg.Columns.Count Select Case B Case 1, 2 T(D, B) = Rg(A, B) Case 3 T(D, 3) = CDbl(Replace(Rg(A + 1, 2), " EUR", "")) Case 4 T(D, 4) = Rg(A + 1, 4) End Select Next A = A + 1 Next
'Où tu veux avoir tes données, Adapte le nom de la feuille 'et l'adresse de la cellule de départ With Worksheets("Extrations") With .Range("G1").Resize(UBound(T, 1), UBound(T, 2)) .Value = Application.Transpose(Arr) .Offset(1).Value = T .Offset(, 2).Resize(.Rows.Count, 1).NumberFormat = "# ##0.00" .EntireColumn.AutoFit End With End With End Sub
