VBA - Aide pour macro de copie
NicoKaraR
Messages postés
17
Date d'inscription
Statut
Membre
Dernière intervention
-
NicoKaraR Messages postés 17 Date d'inscription Statut Membre Dernière intervention -
NicoKaraR Messages postés 17 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
J'ai un petit souci de macro. J'ai bricolé avec mes maigres connaissances jusqu'à présent mais je bloque un peu maintenant.
J'ai un tableau de données dans une première feuille, je veux copier certaines données dans deuxième feuille.
Voici la configuration de la première feuille :
Quand la colonne G est renseignée (non vide), je veux copier E - F - H sur ma feuille 2, I fois.
Et si J est différent de 0, je rajoute une ligne E - F - J.
Avec l'exemple ci-dessus, j'obtiendrai ça :
Feuille 2 :
À l'heure actuelle, j'ai la macro suivante :
Pourriez m'aider un petit peu svp ?!
J'ai un petit souci de macro. J'ai bricolé avec mes maigres connaissances jusqu'à présent mais je bloque un peu maintenant.
J'ai un tableau de données dans une première feuille, je veux copier certaines données dans deuxième feuille.
Voici la configuration de la première feuille :
Col E --- Col F --- Col G --- Col H --- Col I --- Col J
ABCD --- Blabla --- 30 --- 10 --- 3 --- 0
EFGH --- Toitoi --- 8 --- 8 --- 1 --- 0
IJKL --- Albalb --- 36 --- 10 --- 3 --- 4
MNOP --- Iotiot --- 10 --- 4 --- 2 --- 2
Quand la colonne G est renseignée (non vide), je veux copier E - F - H sur ma feuille 2, I fois.
Et si J est différent de 0, je rajoute une ligne E - F - J.
Avec l'exemple ci-dessus, j'obtiendrai ça :
Feuille 2 :
Col A --- Col B --- Col C
ABCD --- Blabla --- 10
ABCD --- Blabla --- 10
ABCD --- Blabla --- 10
EFGH --- Toitoi --- 8
EFGH --- Toitoi --- 8
EFGH --- Toitoi --- 8
IJKL --- Albalb --- 10
IJKL --- Albalb --- 10
IJKL --- Albalb --- 10
IJKL --- Albalb --- 4
MNOP --- Iotiot --- 4
MNOP --- Iotiot --- 4
MNOP --- Iotiot --- 2
À l'heure actuelle, j'ai la macro suivante :
Sub COPIER()
Dim Derlig As Integer, Ligvide As Integer, Lig As Integer, Nbre As Byte, Copies()
Application.ScreenUpdating = False
Sheets("DEUX").Range("A2:D500").ClearContents
With Sheets("UNE")
For Lig = 5 To 139
If .Cells(Lig, "H") > 0 Then
Copies = .Range(.Cells(Lig, "E"), .Cells(Lig, "J")).Value
Nbre = .Cells(Lig, "I")
With Sheets("DEUX")
Ligvide = .Columns("A").Find("", .Range("A1")).Row
.Cells(Ligvide, "A").Resize(Nbre, 6) = Copies
End With
If .Cells(Lig, "J") > 0 Then
Copies = .Range(.Cells(Lig, "E"), .Cells(Lig, "J")).Value
End If
With Sheets("DEUX")
Ligvide = .Columns("A").Find("", .Range("A1")).Row
.Cells(Ligvide, "A").Resize(1, 6) = Copies
End With
End If
Next
End With
End Sub
Pourriez m'aider un petit peu svp ?!
A voir également:
- VBA - Aide pour macro de copie
- Copie cachée - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Super copie - Télécharger - Gestion de fichiers
- Copie écran samsung - Guide
- Copie disque dur - Guide
8 réponses
Merci Gyrus,
Ta macro fonctionne mais j'y comprends rien ! :(
Par contre, quand je l'applique à mon fichier, j'ai une erreur 400.
D'où cela peut-il venir ?
Ta macro fonctionne mais j'y comprends rien ! :(
Par contre, quand je l'applique à mon fichier, j'ai une erreur 400.
D'où cela peut-il venir ?
Désolé, j'ai égaré ma boule de cristal :D
En mode débogage, tu dois voir une ligne surlignée en jaune qui t'indiquera où se situe l'erreur.
A+
En mode débogage, tu dois voir une ligne surlignée en jaune qui t'indiquera où se situe l'erreur.
A+
Ça fonctionne maintenant (j'ai rien touché, juste copié la macro dans un nouveau fichier).
Par contre, que dois-je rajouter pour que cela ne copie pas le format des cellules ?
Par contre, que dois-je rajouter pour que cela ne copie pas le format des cellules ?
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Il faut faire un collage spécial valeurs
A+
Sub COPIER()
Dim LigneS As Long, LigneC As Long
Application.ScreenUpdating = False
Sheets("DEUX").Range("A2:D500").ClearContents
With Sheets("UNE")
For LigneS = 5 To .Range("E" & Rows.Count).End(xlUp).Row
If .Cells(LigneS, "G") > 0 Then
LigneC = Sheets("DEUX").Range("A" & Rows.Count).End(xlUp).Row + 1
.Application.Union(.Range("E" & LigneS), .Range("F" & LigneS), .Range("H" & LigneS)).Copy
Sheets("DEUX").Range("A" & LigneC).Resize(.Cells(LigneS, "I"), 3).PasteSpecial _
Paste:=xlPasteValues
If .Cells(LigneS, "J") > 0 Then
LigneC = Sheets("DEUX").Range("A" & Rows.Count).End(xlUp).Row + 1
.Application.Union(.Cells(LigneS, "E"), .Cells(LigneS, "F"), .Cells(LigneS, "J")).Copy
Sheets("DEUX").Range("A" & LigneC).Resize(1, 3).PasteSpecial _
Paste:=xlPasteValues
End If
End If
Next
End With
End Sub
A+