Copier lignes d'1 feuille à une autre ss cond Résolu

Question

Bonjour, 

Je suis novice en VBA et je cherche à copier coller des lignes de feuilles différentes (8 excactements) sur une autre feuille (recap en quelque sorte) lorsqu'une cellule sur une de ces lignes est différentes de 0. 
Je ne sais pas si j'ai été assez clair? 

Pour être un peu plus clair: j'ai un classeur qui me donne des factures en fonction des bons de livraison. Le probléme est que je peus avoir plusieurs livraisons dans un mois et je souhaite n'avoir q'une seule facture par mois. 
Voila, pas facil d'expliquer clairement mon probléme, j'ai maintenant besoin de l'aide de personnes plus expérimentées que moi en VBA. 

Merci d'avance

ben13.51 · Answer

Salut
Tu peu faire une recherche dans ta colonne mois et copier coller la ligne correspondante au mois souhaité:
Deux solution soit tu applique la méthode  de comparaison de colonne décrite dans la discussion suivante
https://forums.commentcamarche.net/forum/affich-13501092-vba-excel-2k-comparaison#8#dernier

Sinon je te donne ma méthode perso
Dim NumMois As Integer 
'NumMois est la variable qui correspond à ton mois. si il est écrit en texte change integer par string

For j = 1 to 8
For i = x to y
'x = numéro de la première ligne (en générale 2 si tu à des titres à tes colonne)
'y le numéro de la dernière
Val=2
if sheeets(j).cells(i,N)=NumMois then 'N doit être remplacé par le numéro de la colonne qui contient le mois de la facture (A=1, B=2...)

Sheets(j).rows(i).copy
Sheets("recap").select
Shetts("recap").rows(Val).select
Activesheet.paste
Val=val+1
end if
next i
next j

Pour que ça fonctionne il faut que tes huit feuilles dans lesquelles tu cherche soit les huits première feuille de ton classeur, sinon change les valeurs de "for j = 1 to 8". dans tous les cas il faut que ces huits feuille se suivent.
Si tu les à renomées tu peu voir leur numéro dans la fenètre VBA

Pat_59 · Answer

Merci d'avoir répondu!
Par contre, je pense ne pas avoir était clair dans mon explication.
En fait chaqu'une des huit feuilles "facture 1" à 8, reprend un des 8 bons de livraison. Dans chacune de ces factures tout le matériel est listé avec la quantité loué et donc le prix.
Ensuite ce que je cherche à faire maintenant, c'est créer une autre feuille et insérer dans celle-ci chaque lignes avec le nom du matériel et le montant de la location pour le mois. Car dans un même mois, il est possible d'emprunter le même matériel mai durant des périodes différentes.

Voici comment sont mes factures:

Désignation     Px location/jours  	 Type	Quantité	   Nbre jours 	Total

J'espére que ça va t'aider à comprendre mon probléme.

Merci d'avance

Pat_59 · Answer

J'ai réussi à faire deux trois trucs grâce à ta méthode par contre les lignes se colle les unes sur les autres au lieu de se copier à la suite les unes aprés les autre.

Pourrais tu m'aider?

Merci d'avance

ben13.51 · Answer

Essaye de déplacer l'instruction val=2 au dessus de For j=1 to 8
ça devrai éviter que ça se superpose
N'oublie pas le compteur d'incrémentation Val=Val+1 (à la même place que dans l'exemple)

Pat_59 · Answer

C'est bon les lignes ne se superposent plus. Par contre moi je veux que seulmen les lignes ou la cellule de la colonne 10 est différente de 0 se copient. Là je c pas tp ce que ça fais parce que ça me copi des lignes vides aussi?

Voila ce que j'ai modifié à partir de ta méthode:

Dim val As Integer
val = 14
For j = 12 To 18
    For i = 14 To 46
    If Sheets(j).Cells(i, 10) <> 0 Then
    Sheets(j).Rows(i).Copy
    Sheets("FACTURE").Select
    Sheets("FACTURE").Rows(val).Select
    ActiveSheet.Paste
    val = val + 1
    End If
Next i
Next j

Et encore merci pour ton aide

ben13.51 · Answer

est-ce que tu as des cellules vides dans ta colonne 10
Parce que je pense qu'excel considèrent que "" (cellule vide) est différent de 0
Autre idée
est-ce que toute tes feuilles sont remplies jusqu'à la ligne 46?

Pat_59 · Answer

Salut,
Oui j'ai des cellules vides entre ligne 14 et 46, en fait j'ai même des lignes entiérement vide!!!
je dois les supprimer?
Ou mettre 0 dans ces cellules la et le mettre en blanc?

Pat_59 · Answer

J'ai encore une question!!
Esct-ce qu'il serait possible de copier ces lignes dans le même ordres, c-a-d copier ligne 14 de la facture 1 si cellule différente de 0, ensuite pareil L14 de la facture 2,..., puis copier L15 de la facture 1, L15 de la facture 2,...

Est-ce possible? 
Si quelqu'un pouvait m'aider, ça serait vraiment bien et ça m'aiderai beaucoup!!!!

Merci d'avance

jjsteing · Answer

Bonjour,

je pense que ca peut t aider ;)

https://forums.commentcamarche.net/forum/affich-13543719-excel-copier-coller-macro?page=2#35

Pat_59 · Answer

C'est pas vraiment cque jvoudrais, en fait ça serai plutot ça:

Si j'ai:
facture 1

Pat_59 · Answer

C'est pas vraiment cque jvoudrais, en fait ça serai plutot ça:

Si j'ai:
facture 1      h1=1     h2=2    h3=3
facture 2      h1=4     h2=5    h3=6
facture 3      h1=7     h2=8    h3=9
facture 4      h1=10   h2=11   h3=12
facture 5      h1=13   h2=14   h3=15
facture 6      h1=16   h2=17   h3=18
facture 7      h1=19   h2=20   h3=21
facture 8      h1=22   h2=23   h3=24

ça donneré dans la feuille facture:

h1=1    h2=4     h3=7  h4=10   h5=13  h6=16   h7=19    h8=22        
h9=2    h10=5   ...       ...         ...        ...         ...           h16=23  
h17=3  h18=6   ...       ...         ...        ...         ...           h24=24

jjsteing · Answer

ben si c'est du meme style, sauf qu au lieu de travailler avec la colonne a (cells(x,1) tu travaille sur la colonne h qui  vaut 8

ben13.51 · Answer

salut je sais pas si ce que t'as montré jjsteing t'as montré a pu résoudre ton problème Sinon je répond à tes question pour le problème des lignes vides tu n'as qu'à mettre If Sheets(j).Cells(i, 10) <> 0 OR Sheets(j).Cells(i, 10) <> "" Then ... Si tu veux que la ligne 14 feuil2 se copie juste après la ligne 14 Feuil 1 il faut inverser les boucles i et j c'ast à dire: Dim val As Integer val = 14 For i = 14 To 46 inversion For j = 12 To 18 If Sheets(j).Cells(i, 10) <> 0 Then Sheets(j).Rows(i).Copy Sheets("FACTURE").Select Sheets("FACTURE").Rows(val).Select ActiveSheet.Paste val = val + 1 End If Next j Next i inversion

Pat_59 · Answer

Salut,
Tout d'abord merci de ton aide, ça fonctionne bien.
Le probléme maintenant est que en recopiant les lignes sur ma nouvelle feuille les numéros de lignes dans mes fonctions change. Est-ce que l'on ne pourrait pas bloquer avec $ mais sans le faire cellule par cellule ou alors recopier seulement les valeurs et non les formules dans les cellules?

Merci d'avance

ben13.51 · Answer

Effectivement si tu as des formules dans tes cellules, elles vont changer...
Pour coller seulement les valeurs dans ta feuille Facture, remplace la ligne 

"Activesheet.Paste"

Par

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Pat_59 · Answer

Super ça fonctionne. Par contre mes lignes vides se recopient toujours! En fait la j'ai l'impression que l'instruction: If Sheets(j).Cells(i, 10) <> 0 OR Sheets(j).Cells(i, 10) <> "" Then ne fonctionne pas bien car le programme copie toute les lignes. Tu vois quelque chose qui ne va pas dans ce qui est écrit?

ben13.51 · Answer

Oui en fait c'est normale c'est l'opérateur OR qui ne va pas dans ce cas... essaye avec ça peut être remplace OR par XOR et le <>"" par ="" Sheets(j).Cells(i, 10) <> 0 XOR Sheets(j).Cells(i, 10) = "" Then Je ne suis pas sur>>> mais si ça marche dit le moi

Pat_59 · Answer

Impecable!!!
Merci beaucoup. 
Juste histoire d'améliorer mon projet, est-ce qu'il est possible de copier les lignes avec leur mise en forme, c-a-d couleur du texte, couleur de remplissage des cellules,...

Encore merci et désolé de t'innonder de questions!!!!

ben13.51 · Answer

Voilà, avec ça ça devrait marcher
Tu insères les deux première ligne avant les deux dernière qui existe déjà dans ton code
9a permet de coller le format de tes cellules avant d'y coller les valeurs...

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

Pat_59 · Answer

C super!! J'ai un dernier probléme à résoudre mais ne t'inquiéte pas jcomprendrais que tu ne veuille pas répondre aprés tous ce que je t'ai déjà demandé!!! Dans mon classeur j'utilise plusieurs fois la même fonctions comme je te le montre à la suite.Je fais ça car entre les 2 fonctions j'aimerais avoir une cellule à la ligne suivante après ma première fct qui me fasse la somme des valeurs de la colonne 10 à partir de la ligne 14. Ensuite la même chose après chaque fonction, cela me donne des sous total et à la fin après toutes mes fonctions je voudrais avoir une cellule qui me donne la somme de tout les sous total ou la somme de toute ma colonne à partir de ligne 14 sans prendre en compte les sous total biensur. Si tu pouvais m'aider ça serai vraiment génial mais dans le cas contraire je comprendrais. Un grand merci déjà pour toute ton aide Dim val As Integer val = 14 For i = 14 To 46 For j = 10 To 17 If Sheets(j).Cells(i, 9) <> 0 Xor Sheets(j).Cells(i, 9) = " " Then Sheets(j).Rows(i).Copy Sheets("FACTURE").Select Sheets("FACTURE").Rows(val).Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False val = val + 1 End If Next j Next i For i = 48 To 61 For j = 10 To 17 If Sheets(j).Cells(i, 9) <> 0 Xor Sheets(j).Cells(i, 9) = " " Then Sheets(j).Rows(i).Copy Sheets("FACTURE").Select Sheets("FACTURE").Rows(val).Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False val = val + 1 End If Next j Next i

jjsteing · Answer

je pense que ca résoud ton soucis ;) For i = 14 To 61 if i<>47 then For j = 10 To 17 If Sheets(j).Cells(i, 9) <> 0 Xor Sheets(j).Cells(i, 9) = " " Then Sheets(j).Rows(i).Copy Sheets("FACTURE").Select Sheets("FACTURE").Rows(val).Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False val = val + 1 End If Next j end if Next i

Pat_59 · Answer

Ta solution fonctionne aussi pour mes questions précédentes mais je cherche maintenant à faire des sous totaux et un total général!!
Il est peu être possible de faire ça en insérant une fonction dans cellule grace au petit programme.
Enfin je ne sais pas, j'essaie juste de faciliter la tâche à la personne qui pourrai m'aider!!

Merci d'avance

jjsteing · Answer

pour passer une formule en vba :

Cells(maligne,macolonne).Value = "=formulexl"

A noter que vba gere les formules en anglais..

ben13.51 · Answer

Je ne saisi pas bien ton problème
Tes sous totaux doivent être calculés dans quelles cellules:
Seulement dans la cellule ligne 47 colonne 10 et dans la cellule 62 colonne 10 de ta feuille facture?

Si c'est ça tu insert ce code entre les deux fonctions
Sheet("FACTURE").cells(47,10).select
ActiveCell.Formula = "=SUM(J14:J46)"

et tu met celui là à la fin

Sheet("FACTURE").cells(62,10).select
ActiveCell.Formula = "=SUM(J48:J61)"

Pat_59 · Answer

Oui c'est ça, je veus des sous totaux entre deux mais le probléme est qu'il ne serais pas forcément à la ligne 47. Car la premiére fonction peut reprendre les lignes 14 à 46 de mes 8 feuilles...
En fait je voudrais ces sommes dans la colonne 10 et ligne val si je ne me trompe pas!!!

Puis à la fin je voudrais la somme des sous totaux dans la colonne 10 mais pareil, je ne sais pas à quelle ligne!!

J'espére que vous avez compris

Merci d'avance

Pat_59 · Answer

Si ça peut vous aider à comprendre mon probléme voici ce que j'ai essayé mais ça ne fonctionne pas!!
Rien ne s'affiche dans ma case

Sheets("FACTURE").Cells(val, 10).Select
ActiveCell.Formula = "=SUM(J14:J(val-1))"

jjsteing · Answer

ActiveCell.value = "=SUM(J14:J(val-1))" ;)

Pat_59 · Answer

Non désolé ça ne change pas!!

ben13.51 · Answer

ActiveCell.formulaR1C1="=SUM(R[-(Val-14)]C:R[-(val-1)C]" pour le premier sous total

ActiveCell.formulaR1C1="=SUM(R[-(Val-48)]C:R[-(val-1)C]" pour le deuxième sous total

Et pour ta ligne total
.Cells(Val+1,10).select

ActiveCell.formulaR1C1="=SUM(R[-(Val-49)]C;R[-(val)C]"

Pat_59 · Answer

J'ai un message d'erreur(erreur "1004")

ben13.51 · Answer

Bon là tout de suite je peux pas trop faire plus, tout ce que j'essaye ne marche pas plus...
Si je trouve plus tard je te dit

jjsteing · Answer

ActiveCell.formulaR1C1="=SUM(R[-(Val-49)]C;R[-(val)C]"
=>
ActiveCell.formulaR1C1="=SUM(R" & (Val-49)& ";R" & (val) & ")"

pareil pour les autres lignes ;)

val etant une variable cd ton vba il faut la concaténer ;)

Pat_59 · Answer

J'ai toujours cette erreur 1004.

jjsteing · Answer

met un worbook("nom").Activate avant ton code.. erreur 1004 c'est que la feuille n est pas active généralement ;)

bien sur change "nom" par le nom de ta feuille qui doit etre activé ;)

Pat_59 · Answer

worbook ne fonctionne. J'ai essayé comme ça:
 Sheets("FACTURE").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-(Val-49)]C;R[-(val)C]"
et ça ne marche pas non plus!

ben13.51 · Answer

Allez on essaye autre chose... reprend ce code et rajoute ce qui est en gras Dim Tot as Integer (si ta somme ne comporte que des entier sinon as simle si décimal) For i = 14 To 61 if i<>47 then For j = 10 To 17 If Sheets(j).Cells(i, 9) <> 0 Xor Sheets(j).Cells(i, 9) = " " Then Sheets(j).Rows(i).Copy Sheets("FACTURE").Select Sheets("FACTURE").Rows(val).Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Tot=Tot+Sheets("FACTURE").Cells(Val,10).value val = val + 1 End If Next j end if Next i Sheets("FACTURE").Cells(Val,10)=Tot

ben13.51 · Answer

Juste au cas où... c'est "Tot as Single" si tu as des décimales... 
il y avait une faute dans le message précédent

Pat_59 · Answer

salut, merci de réfléchir à mon probléme!!
Alors en applicant les changements g une erreur 13 sur la ligne :
Tot = Tot + Sheets("FACTURE").Cells(val, 10).Value

jjsteing · Answer

t'es sur que ce n'est pas plutot :

Tot = Tot + Sheets("FACTURE").Cells(i, 10).Value ?

et

Sheets("FACTURE").Cells(i,10)=Tot ;)

Pat_59 · Answer

Mais en fait la on ne calcul pas ce qu'il y a dans la case tot
on nomme cette case mais il n'y a pas de formule?
Jme trompe peu être

ben13.51 · Answer

C'est bien Sheets("facture").cells(Val,10)
la variable i s'applique aux autres feuilles mais pas à celle là
je regarde à quoi correspond une erreur 13 et je te dit

et pour répondre à ta question...
Non on nomme pas la cellule
Je crée une variable
chaque foi que tu copies une ligne tu ajoute à cette variable le contenue la cellule colonne 10 de ta nouvelle ligne
A la fin de ta fonction la variable Tot doit avoir la valeur de la somme de ta colonne 10
Lance la sub une foi et vérifie manuellement avec la fonction somme d'excel si les résultats correspondent...
et dit moi ce qu'il en est

ben13.51 · Answer

chez moi ya pas d'erreur
keske il te dit quand il t'annonce erreur 13
et quelle ligne et surlignée en jaune??

essaye de mettre Tot = 0 juste sous le sub() avant le premier For

Pat_59 · Answer

Voila ce que j'ai comme code:

Dim val As Integer
val = 14
Dim Tot As Single
For i = 14 To 61
If i <> 47 Then
For j = 10 To 17
If Sheets(j).Cells(i, 9) <> 0 Xor Sheets(j).Cells(i, 9) = " " Then
Sheets(j).Rows(i).Copy
Sheets("FACTURE").Select
Sheets("FACTURE").Rows(val).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Tot = Tot + Sheets("FACTURE").Cells(val, 10).Value
val = val + 1
End If
Next j
End If
Next i
Sheets("FACTURE").Cells(val, 10) = Tot

message d'erreur: erreur d'execution "13"
incompabilité de type
C cette ligne qui est en jaune: Tot = Tot + Sheets("FACTURE").Cells(val, 10).Value

jjsteing · Answer

met dim Tot as integer au lieu de single ;)

ben13.51 · Answer

Juste pour voir si ça change qqchose essaye d'enlever ce code et de relancé la fonction...

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= _ 
xlNone, SkipBlanks:=False, Transpose:=False 

Si c'es ça le problème fais ces modif...

Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _ 
xlNone, SkipBlanks:=False, Transpose:=False 

Tot = Tot + Sheets("FACTURE").Cells(val, 10).Value 

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= _ 
xlNone, SkipBlanks:=False, Transpose:=False 
val = val + 1 


Si ya tjs cette erreur essaye de m'envoyer ton fichier excel que je puisse essayer sur le vrai modèle
parce que les essais que j'ai fais de mon coté fonctionne bien...

Pat_59 · Answer

Nan toujours le même probléme

Pat_59 · Answer

Tu peus me donner ton adresse mail pour que je te l'envoi

ben13.51 · Answer

préviens moi quand tu es revenu

Pat_59 · Answer

Tu comprend peu être mieu ce que je veus, non?
Ta une solution pour les sous totaux et total général?

ben13.51 · Answer

Allez c bon cette foi on l'a... voilà le code un peu modifié

Private Sub CommandButton14_Click()
Dim i As Integer
Dim j As Integer
Dim val As Integer
val = 14
Dim Tot As Single
For i = 14 To 61
If i <> 47 Then
For j = 10 To 17
If Sheets(j).Cells(i, 9).Value <> "" Then 'pas d'espace entre les guillemets...
If Sheets(j).Cells(i, 9).Value <> 0 Then
Sheets(j).Rows(i).Copy
Sheets("FACTURE").Select
Sheets("FACTURE").Rows(val).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Tot = Tot + Sheets("FACTURE").Cells(val, 10).Value
val = val + 1
End If
End If
Next j
End If
Next i
Sheets("FACTURE").Cells(val, 10) = Tot

End Sub

Avec ça c bon
fais attention aussi ... dans ta colonne 9 (i) correspondant au nombre de jours certaine cellule sont au format monaitaire (0.00€) et écrite en blanc ...invisible sur fond blanc...donc faut les remettre en format standard sinon il ne verra pas qu'elle sont vide
Même problème avec certaine cellule de ta colonne 10

Pat_59 · Answer

Désolé je n'avait pas vu ton message!
Tu as quand même réussi à ouvrir le fichier?

Je ne comprend pas, je viens de tester avec le code que tu m'a donné mais j'ai toujours le probléme, erreur 13!!!

ben13.51 · Answer

regarde dans facture 1 colonne 9 ligne 44 et met 0 ou "" ou rien
en fait le double guillement correspond à cellule vide
tu n'as pas besoin de mettre ="" dans les cellules que tu veux laisser vide
tu n'as d'ailleur pas besoin de mettre 0 non plus...

si ça bug note le i, le j  et le val que te donne vba (il suffit de mettre le curseur sur la variable quand tu as la ligne jaune de bug et il te donne sa valeur) et envoie les moi

Pat_59 · Answer

ça y'est c bon ça fonctionne, merci beaucoup!!!
En fait maintenan je vais utiliser ce code pour chaque sous partie et apré il fodrai que j'arrive a faire la somme des sous totaux, comme dans les facture 1 à 8.

ben13.51 · Answer

pour faire le total des sous toutaux tu nomme Tot11, Tot2...Tot3 les variables dans tes différentes fonctions
et à la fin de la dernière tu rajoute
avec bien sur Total as single
Total = Tot1 + Tot2...+Tot8 
et tu choisi la cellule dans laquelle mettre ce résultat de la même manière que les tot

Pat_59 · Answer

C'est bon!!!!!!!!!!!
Merci pour tous!
Un peu de mise en page et ça sera bon.

Bonne continuation

Copier lignes d'1 feuille à une autre ss cond - Page 3

Discussions similaires

Newsletters