copier coller sous condition

zizan

XLDnaute Nouveau
Bonjour,

Je suis novice en vb, et je voudrais créer un code avec une condition.
Exemple:
Feuille 1: cellule A10 =1, copier la ligne A2 à G2, sur feuille 2 en A2
si
Feuille 1: cellule A10 =2, copier la ligne A2 à G2, sur feuille 3 en A2
si
Feuille 1: cellule A10 =3, copier la ligne A2 à G2, sur feuille 4 en A2
etc

Merci pour votre aide
PS: si vous pouviez mettre quelques explications dans le code ça serait sympa et améliorerai ma compréhension sur le codage..
cordialement

zizan
 

Staple1600

XLDnaute Barbatruc
Bonsoir

Une possibilité de macro
(Lancer la macro, quand c'est la feuille 1 qui est active)
Code:
Sub Copie_Test()
On Error Resume Next
[A2:G2].Copy Sheets([A10]+1).[A2]
End Sub
 

zizan

XLDnaute Nouveau
Bonsoir,

J'ai raccourcis un peu, les chiffres sont des noms et les feuilles portent le nom de la condition.
de ce fait le code ne fonctionne pas désolé.

Merci pour votre aide
 

Staple1600

XLDnaute Barbatruc
Bonsoir

[zizan]
"Ce que l’on conçoit bien s’énonce clairement"
Nicolas Boileau.

Donc joins un fichier exemple (au plus prés de ta réalité)

PS: Ma macro fonctionne, je l'ai testée avant de la poster.
 

zizan

XLDnaute Nouveau
Bonsoir,

Pas de doute sur le fait quelle fonctionne, mais je n'ai pu l'adapter.

Cordialement
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Bonsoir

Essaie cette macro
Code:
Sub Ajouter_2()
Set f = Sheets("Saisie")
f.Range("A2:G2").Copy
Sheets(f.[B7].Value).Cells(Rows.Count, 1).End(3)(2).PasteSpecial Paste:=xlPasteValues
f.Range("B7,B10,D10,B14,D14,F14,B18,C18") = Empty
End Sub
 

zizan

XLDnaute Nouveau
Bonsoir,

Merci beaucoup ça fonctionne nickel.
Maintenant il me reste à l'analyser pour comprendre.

Cordialement

Zizan
 

zizan

XLDnaute Nouveau
Bonsoir,

Comme tu me l'as gentiment proposé, je reviens vers toi pour des explications.
peux tu m'expliquer en détail cette partie du code:
Sheets(f.[B7].Value).Cells(Rows.Count, 1).End(3)(2).
Merci
 

Staple1600

XLDnaute Barbatruc
Bonsoir

Petit test explicatif
( à tester sur un classeur vide avec deux feuilles dont une se nommera toto)
VB:
Sub testE()
'//////////////////////////////////
Set f = Sheets(1): f.[B7] = "Toto"
Randomize 16000
Sheets(f.[B7].Value).Columns(1).Clear
Sheets(f.[B7].Value).[A1].Offset(CLng(Application.RandBetween(1, 30))) = "Test"
'//////////////////////////////////

'renvoie l'adresse de la 1ère cellule vide en dessous
'de la dernière cellule non vide de la colonne A (dans cet exemple)
MsgBox Sheets(f.[B7].Value).Cells(f.Rows.Count, 1).End(3)(2).Address(0, 0)

'écriture plus classique
MsgBox Sheets(f.Range("B7").Value).Cells(f.Rows.Count, "A").End(xlUp).Offset(1).Address(0, 0)
End Sub
PS: le code entre les '//// n'est là que pour créer les données du test.
 

zizan

XLDnaute Nouveau
Bonjour,

Je t'avouerai que cela ne m'a pas beaucoup aidé, c'est trop complexe pour moi.
J'ai changé le nom des feuilles du coup la première version ne fonctionne pas, voilà pourquoi ma demande.

Cordialement
 

Staple1600

XLDnaute Barbatruc
Bonsoir

Tu as testé sur une feuille vide?
Tu as lu les commentaires en vert dans la macro?
Qu'est-ce que tu ne comprends pas dans les explications fournies dans le message#10?

Je vais rajouter des commentaires dans la macro que je t'ai proposé en premier
VB:
Sub Ajouter_2()
'On attribue la variable f à la feuille nommée Saisie
Set f = Sheets("Saisie")
'on copie la plage de cellule A2:G2
f.Range("A2:G2").Copy
' et on colle en valeurs seules dans la feuille dont le nom est saisi dans la cellule
 'B7 de f
'Le collage se fait dans la 1ère cellule vide aprés ladernière cellule non vide
'de la colonne A
Sheets(f.[B7].Value).Cells(Rows.Count, 1).End(3)(2).PasteSpecial Paste:=xlPasteValues
'On efface le contenu des cellules ci-dessous
f.Range("B7,B10,D10,B14,D14,F14,B18,C18") = Empty
End Sub
PS: Le code du message précédent était juste là pour montrer que la syntaxe de type
Cells(Rows.Count, NumeroColonne).End(3)(2) permet bien d'identifier la 1ère cellule vide après la dernière cellule non vide du colonne donnée.

Normalement avec tout cela, tu dois avoir compris cette syntaxe, non?
 
Dernière édition:

zizan

XLDnaute Nouveau
Bonsoir,

Merci de répondre aussi rapidement.
J'ai fait le test et cela fonctionne, mais ma recherche n'est pas pour générer des valeurs aléatoires.
Dans les cellules B7 de la feuille 1 contient une liste de noms de mes différentes feuilles.
Suite a ce choix je désire déplacer les saisies dans les feuilles correspondantes.
ce que je ne comprends pas, c'est pourquoi cela fonctionne avec ton premier code et dés que je change le nom des feuilles cela ne fonctionne plus. a aucun moment tu ne cites de nom dans ton code d'ou mon incompréhension, qui est certainement lié à mon ignorance.
 

Staple1600

XLDnaute Barbatruc
Bonjour

Petit test explicatif
( à tester sur un classeur vide avec deux feuilles dont une se nommera toto)

PS: le code entre les '//// n'est là que pour créer les données du test.
Je sais donc pertinemment qu'il ne s'agit pas de créé des données aléatoires ;)
Donc merci de lire mes réponses de A à Z ;)
Dans le message#6, je t'ai proposé une macro en rapport avec ta question
Ensuite tu m'as demandé des explications sur une syntaxe VBA
Explications que je t'ai donnée avec une macro illustrative dans le message#10.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re

Un autre test (pour commencer la matinée ;))
A tester sur un classeur vierge
1) Copie les deux macros ci-dessous dans un classeur avec une seule feuille
2) Lance la macro nommée Macro_Outil_Juste_pour_TEST
3) Insère un Bouton (issu de Contrôles de formulaires) sur la feuille Saisie
Testes en changeant les noms en B7 (avec la liste déroulante)
Les données sont bien recopiées sur la feuille choisie en B7, non ?
4) Affecte la macro nommée Ajouter_3 à ce bouton
Code:
Sub Macro_Outil_Juste_pour_TEST()
'cette macro ne sert qu'à créer les conditions pour tester la macro Ajouter_3
'A utiliser sur un classeur vierge avec une seule feuille vide
Dim i As Byte
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("A").Delete: Worksheets("B").Delete: Worksheets("C").Delete:
On Error GoTo 0
For i = 1 To 3
Sheets.Add(after:=Sheets(Sheets.Count)).Name = Chr(64 + i)
Next
With Sheets(1)
  .Name = "Saisie"
  .Range("A2:G2") = "=INT(ROW()^COLUMN()/RAND())"
  With .[B7].Validation: .Delete: .Add Type:=3, AlertStyle:=1, Operator:=1, Formula1:="A,B,C": End With
End With
End Sub
Sub Ajouter_3()
Set f = Sheets("Saisie")
Select Case Len(f.[B7])
Case Is > 0
Application.ScreenUpdating = False
f.Range("A2:G2").Copy
Sheets(f.[B7].Value).Cells(Rows.Count, 1).End(3)(2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
f.Range("B7,B10,D10,B14,D14,F14,B18,C18") = Empty
Case Else
Application.CutCopyMode = False
MsgBox "Veuillez renseigner le nom d'une feuille dans la cellule B7!", vbCritical, "Erreur"
End
End Select
End Sub
 

zizan

XLDnaute Nouveau
bonjour,
En effet je n'avais pas lu le message #12 de A à Z:mad:, et grâce à lui et tes explications j'ai bien compris le code:p.
Mais malgré ça cela ne fonctionnais pas. En cherchant j'ai fini par trouver :rolleyes:.
Sur mon fichier joint il y a une feuille paramètre sur laquelle est ma liste déroulante avec les noms des feuilles, d’où l'erreur.
j'ai transposé sur la feuille 1, sur laquelle il n'y a pas de recherche et ça fonctionne.
Merci pour ton aide et ta patience.
Tu m'as bien aidé et surtout bien expliqué.
Si tu veux bien je ferai appel à ton savoir pour d'autre code sur ce même classeur.
Comme tu as pu le voir je veux gérer mes comptes persos sur ce fichier, et je voudrais créer les prélèvements mensuels pour chaque feuilles.
si tu as une idée
Merci;)
 

Discussions similaires


Haut Bas