XL 2016 Extrayez les dates des factures et recopiez-les sur la dernière ligne de la facture vba

Dadi147

Dadi147

XLDnaute Occasionnel
Bonjour .cv puis-je copier la cellule E2 le long de la colonne de facture B En commençant par la cellule B6 et copier la date dans la colonne A avec la cellule A6
Jusqu’à la dernière ligne du premier projet de loi, puis la même chose sera répétée sur les projets de loi suivants
Ainsi, lorsque vous ajoutez une nouvelle facture, ses données sont copiées dans les mêmes colonnes pour modifier le nom de la date que dans le fichier joint

Capture.PNG
 

Pièces jointes

  • TEST.xlsm
    24 KB · Affichages: 7
Solution
job75
Bonjour Dadi147, jm.andryszak, le forum,

Vous pouvez utiliser cette macro :
VB: 
Sub Remplir_tout()
Dim nmax&, a$(), derlig&, tablo, i&, n&, c As Range, dat$, h&
With Sheets("Sheet1")
    '---liste des adresses---
    nmax = Application.CountIf(.[E:E], "Restaurant*")
    ReDim a(nmax) 'base 0
    derlig = .Range("C" & .Rows.Count).End(xlUp).Row + 1
    a(nmax) = "E" & derlig 'dernier élément
    tablo = .Range("E1:F" & derlig) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To derlig
        If Trim(tablo(i, 1)) Like "Restaurant*" Then a(n) = "E" & i: n = n + 1
    Next i
    '---remplissage des colonnes A et B
    Application.ScreenUpdating = False
    .[A:B].ClearContents 'RAZ
    .[A:B].HorizontalAlignment = xlCenter...
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Bonsoir Dadi147,

Exécutez cette macro :
VB: 
Sub Remplir()
Dim c As Range, dat, h&
With Sheets("Sheet1")
    Set c = .Columns("E").Find("Restaurant*", , xlValues, , , xlPrevious)
    dat = Mid(Trim(c(7, 0)), 11, 10)
    h = .Range("C" & .Rows.Count).End(xlUp).Row - c(5).Row
    If h < 1 Then Exit Sub
    If IsDate(dat) Then c(6, -3).Resize(h) = CDate(dat)
    c(6, -2).Resize(h) = c(2)
    c(6, -3).Resize(h, 2).HorizontalAlignment = xlCenter 'centrage
End With
End Sub
Bonne nuit.
 
Vote positif 0 Vote négatif
Dadi147

Dadi147

XLDnaute Occasionnel
job75 à dit:
Bonsoir Dadi147,

Exécutez cette macro :
VB: 
Sub Remplir()
Dim c As Range, dat, h&
With Sheets("Sheet1")
    Set c = .Columns("E").Find("Restaurant*", , xlValues, , , xlPrevious)
    dat = Mid(Trim(c(7, 0)), 11, 10)
    h = .Range("C" & .Rows.Count).End(xlUp).Row - c(5).Row
    If h < 1 Then Exit Sub
    If IsDate(dat) Then c(6, -3).Resize(h) = CDate(dat)
    c(6, -2).Resize(h) = c(2)
    c(6, -3).Resize(h, 2).HorizontalAlignment = xlCenter 'centrage
End With
End Sub
Bonne nuit.
Cliquez pour agrandir...
Merci beaucoup
Le code fonctionne bien pour vous, mais seules les données de la dernière facture sont copiées, est-il possible de remplir une facture vierge ?
 

Pièces jointes

  • TEST1.xlsm
    28.7 KB · Affichages: 10
Vote positif 0 Vote négatif
J

jm.andryszak

XLDnaute Occasionnel
Bonjour
Essayez ceci, je n'ai pas trouvé d'erreur.
Sub ToutesLesFacturesVierges()
Dim i
Dim Formule
For i = 1 To Range("c" & Rows.Count).End(xlUp).Row
If InStr(1, Range("e" & i).Value, "Restaurant", vbTextCompare) > 0 Then
'NB.SI
Formule = "=" & "COUNTIF(" & "a" & i & ":" & "a" & i + 72 & "," & """""" & ")" & "+" & "COUNTIF(" & "b" & i & ":" & "b" & i + 72 & "," & """""" & ")"
'Seules les 5 premieres lignes de la facture sont vides en colonne A et B ==> 10
If Evaluate(Formule) <> 10 Then
Remplir Range("e" & i), 68 '73 - les 5 premieres lignes de la facture
End If
End If
Next
End Sub
'***********************************************
Sub ToutesLesFactures()
Dim i
For i = 1 To Range("c" & Rows.Count).End(xlUp).Row
If InStr(1, Range("e" & i).Value, "Restaurant", vbTextCompare) > 0 Then
Remplir Range("e" & i), 68 '73 - les 5 premieres lignes de la facture
End If
Next
End Sub
'***********************************************
Sub Remplir(C As Range, h)
Dim dat
With Sheets("Sheet1")
dat = Mid(Trim(C(7, 0)), 11, 10)
'If h < 1 Then Exit Sub
If IsDate(dat) Then C(6, -3).Resize(h) = CDate(dat)
C(6, -2).Resize(h) = C(2)
C(6, -3).Resize(h, 2).HorizontalAlignment = xlCenter 'centrage
End With
End Sub
'***********************************************
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Dadi147, jm.andryszak, le forum,

Vous pouvez utiliser cette macro :
VB: 
Sub Remplir_tout()
Dim nmax&, a$(), derlig&, tablo, i&, n&, c As Range, dat$, h&
With Sheets("Sheet1")
    '---liste des adresses---
    nmax = Application.CountIf(.[E:E], "Restaurant*")
    ReDim a(nmax) 'base 0
    derlig = .Range("C" & .Rows.Count).End(xlUp).Row + 1
    a(nmax) = "E" & derlig 'dernier élément
    tablo = .Range("E1:F" & derlig) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To derlig
        If Trim(tablo(i, 1)) Like "Restaurant*" Then a(n) = "E" & i: n = n + 1
    Next i
    '---remplissage des colonnes A et B
    Application.ScreenUpdating = False
    .[A:B].ClearContents 'RAZ
    .[A:B].HorizontalAlignment = xlCenter 'centrage
    For n = 0 To UBound(a) - 1
        Set c = .Range(a(n))
        dat = Mid(Trim(c(7, 0)), 11, 10)
        h = .Range(a(n + 1)).Row - 1 - c(5).Row
        If h > 0 Then
            If IsDate(dat) Then c(6, -3).Resize(h) = CDate(dat)
            c(6, -2).Resize(h) = c(2)
        End If
    Next n
End With
End Sub
Par curiosité, à quoi vont vous servir les colonnes A et B ?

A+
 
Vote positif 0 Vote négatif
Solution
Dadi147

Dadi147

XLDnaute Occasionnel
job75 à dit:
Bonjour Dadi147, jm.andryszak, le forum,

Vous pouvez utiliser cette macro :
VB: 
Sub Remplir_tout()
Dim nmax&, a$(), derlig&, tablo, i&, n&, c As Range, dat$, h&
With Sheets("Sheet1")
    '---liste des adresses---
    nmax = Application.CountIf(.[E:E], "Restaurant*")
    ReDim a(nmax) 'base 0
    derlig = .Range("C" & .Rows.Count).End(xlUp).Row + 1
    a(nmax) = "E" & derlig 'dernier élément
    tablo = .Range("E1:F" & derlig) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To derlig
        If Trim(tablo(i, 1)) Like "Restaurant*" Then a(n) = "E" & i: n = n + 1
    Next i
    '---remplissage des colonnes A et B
    Application.ScreenUpdating = False
    .[A:B].ClearContents 'RAZ
    .[A:B].HorizontalAlignment = xlCenter 'centrage
    For n = 0 To UBound(a) - 1
        Set c = .Range(a(n))
        dat = Mid(Trim(c(7, 0)), 11, 10)
        h = .Range(a(n + 1)).Row - 1 - c(5).Row
        If h > 0 Then
            If IsDate(dat) Then c(6, -3).Resize(h) = CDate(dat)
            c(6, -2).Resize(h) = c(2)
        End If
    Next n
End With
End Sub
Par curiosité, à quoi vont vous servir les colonnes A et B ?

A+
Cliquez pour agrandir...
Merci beaucoup. C'est ce dont nous avons vraiment besoin. Vous êtes un génie. Salutations à vous.
 
Vote positif 0 Vote négatif
Dadi147

Dadi147

XLDnaute Occasionnel
jm.andryszak à dit:
Bonjour
Essayez ceci, je n'ai pas trouvé d'erreur.
Sub ToutesLesFacturesVierges()
Dim i
Dim Formule
For i = 1 To Range("c" & Rows.Count).End(xlUp).Row
If InStr(1, Range("e" & i).Value, "Restaurant", vbTextCompare) > 0 Then
'NB.SI
Formule = "=" & "COUNTIF(" & "a" & i & ":" & "a" & i + 72 & "," & """""" & ")" & "+" & "COUNTIF(" & "b" & i & ":" & "b" & i + 72 & "," & """""" & ")"
'Seules les 5 premieres lignes de la facture sont vides en colonne A et B ==> 10
If Evaluate(Formule) <> 10 Then
Remplir Range("e" & i), 68 '73 - les 5 premieres lignes de la facture
End If
End If
Next
End Sub
'***********************************************
Sub ToutesLesFactures()
Dim i
For i = 1 To Range("c" & Rows.Count).End(xlUp).Row
If InStr(1, Range("e" & i).Value, "Restaurant", vbTextCompare) > 0 Then
Remplir Range("e" & i), 68 '73 - les 5 premieres lignes de la facture
End If
Next
End Sub
'***********************************************
Sub Remplir(C As Range, h)
Dim dat
With Sheets("Sheet1")
dat = Mid(Trim(C(7, 0)), 11, 10)
'If h < 1 Then Exit Sub
If IsDate(dat) Then C(6, -3).Resize(h) = CDate(dat)
C(6, -2).Resize(h) = C(2)
C(6, -3).Resize(h, 2).HorizontalAlignment = xlCenter 'centrage
End With
End Sub
'***********************************************
Cliquez pour agrandir...
Salut jm.andryszak, l'expérience a été faite et ça marche bien aussi. La meilleure réponse a été choisie en raison de la tentative répétée de job75 et de ne pas ignorer ma demande. Vraiment merci à tous pour l'aide
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
XL 2016 VBA Détecter la suppression de la dernière ligne d'un Tableau
Réponses
9
Affichages
441
crocrocro
C
B
  • Question
XL 2016 VBA formulaire incrémenter un N° de facture selon l'année(mais dates sur deux colonnes)
Réponses
4
Affichages
571
badduke
B
M
  • Question
XL 2019 Copier des lignes les unes a la suite des autres dans une autre feuille sous conditions et seulement certaines colonnes
Réponses
7
Affichages
636
MGH
M
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
1 K
Vermithor
V
K
  • Résolu(e)
XL 2013 recherche en fonction de la valeur et du rang sur une ligne
Réponses
5
Affichages
308
komarlehomard
K
S
  • Résolu(e)
Microsoft 365 Copier automatiquement sur une ligne sur une autre feuille si la date est supérieur à une date définie
2
Réponses
17
Affichages
983
S.J
S
C
  • Question
XL 2010 Recherche de colonne et calcul sur 2 années consécutives
Réponses
0
Affichages
211
CS49
C
C
  • Résolu(e)
Autres Code VBA pour recherche et copie/coller de ligne avec mot clé.
Réponses
12
Affichages
523
Corentin26270
C
Roseline
  • Résolu(e)
Microsoft 365 Trouver la dernière ligne de tous les onglets par VBA
Réponses
4
Affichages
386
job75
job75
J
  • Résolu(e)
XL 2016 Validation d'une ligne et transfert de la ligne vers un autre classeur
Réponses
8
Affichages
371
job75
job75

Membres actuellement en ligne

9 membres et 71 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 096
Messages
2 116 184
Membres
112 678
dernier inscrit
arno12345678