Copie des cellules de differentes feuilles avec VBA

emenemza -  
 emenemza -
Bonjour,

Je suis débutante en Excel.

J'essaye de créer un petit CRM.
J'ai 3 feuilles dans un dossier qui contiennent des colonnes nom, prénom, tel et email en plus d'autres information.
Sur une 4 eme feuille Newsletter je veux avoir ces colonnes là et à chaque fois que je saisi un nouveau client sur l'une des 3 feuilles je le retrouve dans la feuille newsletter.

J'ai utilisé ce code sur une seule feuille pour commencer :

Sub Macro1()

Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long

Worksheets(7).Activate ' feuille de destination

Col = "B" ' colonne de la donnée non vide à tester
NumLig = 0
With Worksheets(2) ' feuille source
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig
If .Cells(Lig, Col).Value <> "" Then

.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Cells(NumLig, 1).Select
ActiveSheet.Paste

End If
Next
End With

End Sub

Le souci c'est que ce code me copie la ligne entière avec toutes les colonnes, alors que moi j'ai besoin de copier uniquement les colonnes B, C et H, ou si c'est trop compliqué, la plage de B:H

Votre aide est vraiment appréciée.
A voir également:

3 réponses

Zoul67 Messages postés 1959 Date d'inscription   Statut Membre Dernière intervention   149
 
Bonjour,

Bienvenue dans ce monde merveilleux.
Plutôt que copier-coller chaque ligne via
  For Lig = 1 To NbrLig
If .Cells(Lig, Col).Value <> "" Then

.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Cells(NumLig, 1).Select
ActiveSheet.Paste

End If
Next
copie-colle plutôt toute la plage :
    .Range("B1:C" & NbrLig & ",H1:H" & NbrLig).Copy
ActiveSheet.Paste

J'espère ne pas m'être emmêlé, je n'ai pas testé sous Excel.

A+
0
emenemza
 
Bonjour,
Merci pour votre réponse.
Je n'ai pas encore testé votre code, mais entre temps j'ai fait un autre code pour copier les cellules correspondantes aux colonnes que je veux :

 Dim DerniereLigne As Long 'dans la feuille à écrire
Dim LigneActive As Long 'dans la feuille à lire
Worksheets(2).Select 'feuille source
Range("B3").Select

While ActiveCell.Value <> Empty
LigneActive = ActiveCell.Row 'n° de la ligne "à lire"
'If Cells(LigneActive, 6).Value = "H" And Cells(LigneActive, 11).Value = "B-" Then

'écriture dans la feuille destination
With Worksheets(7)
DerniereLigne = .Range("A65536").End(xlUp).Offset(1, 0).Row 'n° de la ligne "à écrire"
.Cells(DerniereLigne, 1).Value = Cells(LigneActive, 2).Value 'écrit dans la 1ère colonne la valeur trouvée dans la colonne B
.Cells(DerniereLigne, 2).Value = Cells(LigneActive, 3).Value ' écrit dans la 2è colonne la valeur trouvée dans la colonne C
.Cells(DerniereLigne, 5).Value = Cells(LigneActive, 8).Value ' écrit dans la 5è colonne la valeur trouvée dans la colonne H
.Cells(DerniereLigne, 3).Value = Cells(LigneActive, 5).Value 'écrit dans la 4è colonne la valeur trouvée dans la colonne F
.Cells(DerniereLigne, 4).Value = Cells(LigneActive, 7).Value 'écrit dans la 4è colonne la valeur trouvée dans la colonne G

End With


'End If
ActiveCell.Offset(1, 0).Activate

Wend

Le souci maintenant c'est que à chaque fois que la macro s'execute, les lignes sont réecrite, j'ai besoin de faire alors un test d'unicité!!
Je ne peux pas supprimer les lignes à chaque fois, car ce code est destinée à être mis dans l'évènement change de 3 feuilles qui alimentent toutes la feuille destination.

any ideas??
0
Zoul67 Messages postés 1959 Date d'inscription   Statut Membre Dernière intervention   149
 
Je n'aime pas trop l'idée avec Change...
- soit donner un identifiant par ta feuille récapitulatif que tu viendrais affecter dans tes 3 feuilles sources ;
- soit utiliser des formules au lieu de macros (mais ça gonfle la taille du fichier avec INDIRECT, tout ça...) + un filtre dans la feuille récap pour ne pas afficher les lignes vides.
0
emenemza
 
Oui en effet, apparemment je ne comprenais pas vraiment le fonctionnement de l'événement Change, j'ai mis le code alors dans l'événement afterSave du classeur, et ça fonctionne avec une seule feuille, je vais tester maintenant pour les autres.

Merci pour votre soutien Zoul67
0
foo
 
Bonjour

Pour copier B,C,H ex:

Lig = 8
Range("B" & Lig & ":C" & Lig & ",H" & Lig).Copy

Range("B19").PasteSpecial xlPasteValues

A+
Maurice
0