comment transférer 5 cellules ?

tactic6

XLDnaute Impliqué
Bonsoir à tous
en suivant les conseils de Tibo j'ai réalisé un petit projet qui me tenait à coeur en je le remercie encore et encore
comme un gamin je n'en ai pas assez et je voudrais encore modifier mon petit bébé

je voudrais recopier les cellules B11:G4:I5:G7:I58 de ma feuille1
sur les cellules A2:B2:C2: D2:E2 de ma feuille 2

en fouillant un peu et en pensant rivaliser avec vous j'ai crée ceci:

Sub Transfert()
Worksheets("Feuil1").Range("B11:G4:I5:G7:I58").Copy _
Destination:=Worksheets("Feuil2").Range("A2:B2:C2: D2:E2")
End Sub

je vous voie déjà rigoler car bien sur ça ne marche pas!

si une bonne âme pouvait m'aider encore une fois ....

Merci

Edit:

je souhaiterais que les ecritures sur la feuille 2 se suivent sans ecraser les precedentes
du genre A3:B3:C3: D3:E3 puis A4:B4:C4: D4:E4 etc etc
bien sur le depart étant toujours B11:G4:I5:G7:I58 de la feuille 1
 
Dernière édition:

tactic6

XLDnaute Impliqué
Re : comment transférer 5 cellules ?

merci c'est gentil
voici donc le code que j'ai compilé avec votre aide et mes recherches:

Sub Transfert()
Dim ligne As Integer
Dim colonne As Byte
Dim cellule As Range

Sheets("facture").Select

If Range("C12").Value = "" Then
MsgBox "Il n' y a pas de nom, la facture ne peut pas être enregistrée"
Exit Sub
End If
If Range("J6").Value = "" Then
MsgBox "Il n' y a pas de numéro, la facture ne peut pas être enregistrée"
Exit Sub
End If
If Range("H5").Value = "Date" Then
MsgBox "Il n' y a pas de Date, la facture ne peut pas être enregistrée"
Exit Sub
End If
ligne = Worksheets("Feuil1").Range("A65536").End(xlUp).Row + 1

For Each cellule In Worksheets("Facture").Range("c12,h5,j6,h8,h12,j59")
colonne = colonne + 1
Worksheets("Feuil1").Cells(ligne, colonne) = cellule
Next cellule
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

End Sub

actuellement je suis en train d'essayer de mettre une ligne qui contrôle le numéro des facture afin de ne pas saisir 2 factures avec le même numéro

ça a juste besoin d'être remanié et ordonné mais excel je n'y suis que depuis ma première question et honnêtement c'est dur dur
vous méritez bien les éloges qu'on vous fait

merci pour votre aide

PS
je ne sais pas si c'est important mais ma facture est situeé en B2 et K63 sur la feuille excel
 
Dernière édition:

fred65200

XLDnaute Impliqué
Re : comment transférer 5 cellules ?

re:

tu peux uploader ton classeur zippé, je suis un peu perdu dans tes références de cellule entre ton code et ton premier classeur.

edit Peux tu utiliser les balises
Code:
 et [ /code] quand tu postes un code, c'est plus lisible. Le bouton avec un dièse ([B]#[/B]) en Mode Avancé.

@+
 
Dernière édition:

fred65200

XLDnaute Impliqué
Re : comment transférer 5 cellules ?

re:

voici une solution avec gestion des doublons sur les numéros de facture
Code:
Option Base 1
Sub Transfert2()
Dim tablo(1, 6)
Dim tabloErreur As Variant
Dim tabloMsg As Variant
Dim tabloFacture As Variant
Dim Msg As String
Dim Msg1 As String
Dim Msg2 As String
Dim F1  As Worksheet
Dim F2 As Worksheet
Dim Derli As Long
Dim i As Integer
 
 'initialisation des variables
Set F1 = Sheets("Facture")
Set F2 = Sheets("Feuil1")
 ' affectaction des valeurs de cellules au tableau
tablo(1, 1) = F1.[C12]
tablo(1, 2) = F1.[H5]
tablo(1, 3) = F1.[J6]
tablo(1, 4) = F1.[H8]
tablo(1, 5) = F1.[H12]
tablo(1, 6) = F1.[J59]
'Gestion des cellules non renseignées
tabloErreur = Array("", "Date", "")
tabloMsg = Array("nom", "date", "numéro")
Msg1 = "Il n'y a pas de "
Msg2 = ", la facture ne peut pas être enregistrée."
'boucle pour l'affichage des cellules non remplies
For i = 3 To 1 Step -1
   If tablo(1, i) = tabloErreur(i) Then Msg = Msg & vbLf & Msg1 & tabloMsg(i) & Msg2
Next i
'si une condition remplie, affichage du message d'erreur et fin de Sub
If Not Msg = "" Then MsgBox Msg : Exit Sub

'Recherche  de la dernière ligne de l'onglet "Feuil1"
Derli = F2.Columns("A").Find("*", , , , , xlPrevious).Row ' + 1

'Gestion des doublons
tabloFacture = F2.Range("C1:C" & Derli).Value
'si doublon, affichage du message et fin de Sub
If Not IsError(Application.Match(tablo(1, 3), tabloFacture, 0)) Then _
   MsgBox "Le numéro de facture """ & tablo(1, 3) & """ existe déja!": Exit Sub

'insertion des données sur Feuil1
Derli = Derli + 1
F2.Cells(Derli, "I").Value = Now
F2.Range("A" & Derli & ":F" & Derli).Value = tablo

'Je te laisse gérer la mise en page et l'impression
'et te conseille
'Application.ExecuteExcel4Macro "PAGE.SETUP("Arg1,Arg2,,,,,,,,,,,,,,,,,,Arg20,Arg21)"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub
cordialement
 
Dernière édition:

tactic6

XLDnaute Impliqué
Re : comment transférer 5 cellules ?

Bonjour à tous

merci fred65200 pour aide plus que précieuse (j'envie ton savoir à manipuler excel)

je viens de tester ta macro et j'ai quelques petits problemes:

- Si j'oublie de renseigner une des cellules ayant une condition le message d'erreur n'est pas précis j'ai juste un FAUX qui s'affiche sans dire où
(limite c'est pas trop grave puisque je n'ai que 3 conditions)

- Je ne gère toujours pas les doublons (je peux enregistrer deux fois et plus avec le même numéro)

- Je n'ai pas réussi à utiliser ta ligne de commande pour l'impression si je sort ton ( ' ) pour la rendre active j'ai un message du genre: Erreur de compilation Attendu fin d'instruction

- dernier " petit " truc j'aimerai faire mes sauvegardes automatiquement sur une autre feuille excel dans une autre partie de mon disque dur ( au cas ou ....) est-ce possible ?

Merci et bon dimanche
 

fred65200

XLDnaute Impliqué
Re : comment transférer 5 cellules ?

bonjour,

petite erreur sur cette ligne de code
Code:
'si une condition remplie, affichage du message d'erreur et fin de Sub
If Not Msg = "" Then MsgBox Msg [B][COLOR=Red]= ""[/COLOR][/B]: Exit Sub
remplace la par
Code:
'si une condition remplie, affichage du message d'erreur et fin de Sub
If Not Msg = "" Then MsgBox Msg: Exit Sub
Je ne comprends pas bien l'erreur sur la gestion des doublons, on parle bien du numéro de facture, cellule J6 de l'onglet Facture?

EDIT que veux tu sauvegarder, la facture, la feuil1?
EDIT 2 pour la mise en page, il faut remplir les Arguments, ne pas laisser Arg1, Arg2...
si tu ne trouves pas la liste, je te l'enverrai
@+
 
Dernière édition:

fred65200

XLDnaute Impliqué
Re : comment transférer 5 cellules ?

re

un test pour la sauvegarde
Code:
Sub Sauvegarde()
Const DossierSauvegarde As String = "C:\Sauvegardes\" ' à modifier selon l'emplacement de ton dossier
Dim AWbk As Workbook
Dim LaFin As String
Dim Nb As Byte
Dim Ext
Dim NomClasseur As String
Set AWbk = ActiveWorkbook

'nom du classeur sans l'extension
NomClasseur = Left(AWbk.Name, Len(AWbk.Name) - InStr(1, StrReverse(AWbk.Name), "."))
'extension
Ext = Right(AWbk.Name, InStr(1, StrReverse(AWbk.Name), "."))
'date et heure
LaFin = Format(Now, "dd-mm-yy hh-mm-ss")
'enregistrement de la copie
ActiveWorkbook.SaveCopyAs DossierSauvegarde & NomClasseur & " " & LaFin & Ext

If MsgBox("Ouvrir le dossier de sauvegarde ?", vbYesNo) = vbYes Then _
   Shell "C:\WINDOWS\EXPLORER.EXE /n,/e," & DossierSauvegarde, vbNormalFocus

End Sub

@+
 

tactic6

XLDnaute Impliqué
Re : comment transférer 5 cellules ?

Bonjour
EDIT je voudrais faire une sauvegarde de la feuil 1 vers un autre dossier
EDIT 2 je veux bien que tu me l'envoie

pour les doublons: quand j'ai fini de remplir ma feuille facture je clic sur un bouton dans lequel j'ai affecté ta macro jusque là c'est ok

ta macro enregistre certaines cellules sur la feuil1 jusque là ok aussi

mais dans la colonne C de la feuil 1 ( ceux sont les numéros des factures) il peut y avoir plusieurs fois les mêmes numéros (c'est ça que je voulais éviter)
:)
 

tactic6

XLDnaute Impliqué
Re : comment transférer 5 cellules ?

Hello
je viens d'éssayer ta macro de sauvegarde mais elle m'enregistre le classeur entier alors que je voudrais juste la feuil1 ou la facture (pas le classeur parce que j'ai le fichier client, fournisseur, articles et ça pese plus 1 mo)
 

fred65200

XLDnaute Impliqué
Re : comment transférer 5 cellules ?

re
EDIT pour les doublons, si je saisie un numéro de facture dans l'onglet facture en J6, et que ce numéro est déjà présent dans Feuil1, j'ai un message d'alerte et ne peux pas enregistrer cette facture. Si tes doublons sont déjà présents sur Feuil1, ce n''est pas testé.

Sauvegarde Feuil1
Code:
Sub SauvegardeFeuil1()
Const DossierSauvegarde As String = "C:\Sauvegardes\" ' à modifier selon l'emplacement de ton dossier
Dim AWbk As Workbook
Dim LaFin As String
Dim Nb As Byte
Dim Ext
Dim NomClasseur As String
Set AWbk = ActiveWorkbook

'nom du classeur sans l'extension
NomClasseur = Left(AWbk.Name, Len(AWbk.Name) - InStr(1, StrReverse(AWbk.Name), "."))
'extension
Ext = Right(AWbk.Name, InStr(1, StrReverse(AWbk.Name), "."))
'date et heure
LaFin = Format(Now, "dd-mm-yy hh-mm-ss")
'enregistrement de la copie
    Sheets("Feuil1").Copy
ActiveWorkbook.SaveAs DossierSauvegarde & NomClasseur & " " & LaFin & Ext, xlExcel8 ' tu peux supprimer xlExcel8
ActiveWorkbook.Close
If MsgBox("Ouvrir le dossier de sauvegarde ?", vbYesNo) = vbYes Then _
   Shell "C:\WINDOWS\EXPLORER.EXE /n,/e," & DossierSauvegarde, vbNormalFocus

End Sub
--------------------------


'Pour la mise en page les arguments sont les suivants :
'
''Arg1 En-tête
''Arg2 Pied de page
''Arg3 Marge Gauche en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
''Arg4 Marge Droite en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
''Arg5 Marge Haut en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
''Arg6 Marge Bas en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
''Arg7 Titre FALSE= sans, TRUE =
''Arg8 Grille FALSE ou TRUE
''Arg9 Centré Horizontalement = 1, sinon 0
''Arg10 Centré Verticalement = 1, sinon 0
''Arg11 Orientation - 1 = Portrait, 2 = Paysage
''Arg12 Type de papier - une constante XlPaperSize
''Arg13 Echelle - nombre < 400
''Arg14 Départ numérotation
''Arg15 Ordre d'impression - 1 = haut en bas, 2 = Gauche à droite
''Arg16 Couleur - 0 = avec couleur, 1 = Noir et Blanc
''Arg17 Qualité
''Arg18 En-tête en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
''Arg19 Pied de page en pouce (diviser par 2.54, avec le point (.) en séparateur décimal
''Arg20 Commentaire - 0 = sans, 1 = avec
''Arg21 Brouillon - 0 ou 1
'
'Application.ExecuteExcel4Macro "PAGE.SETUP("Arg1,Arg2,,,,,,,,,,,,,,,,,,Arg20,Arg21)"
@+
 
Dernière édition:

fred65200

XLDnaute Impliqué
Re : comment transférer 5 cellules ?

je ne voie vraiment pas comment utiliser tous ces arguments ???:confused:
L'utilisation des macros Xl4 pour la mise en page est beaucoup plus rapide que l'utilisation du code VBA classique. C'est juste pour un gain en rapidité. Si ta mise enpage est déjà effectuée, conserve ton code.
Sinon fait un recherche, tu trouvera des exemples.

Toujours de problèmes de doublon?

cordialement
 

tactic6

XLDnaute Impliqué
Re : comment transférer 5 cellules ?

ATTEND

maintenant ça marche !!!!
strange strange

je me rend compte que ça marche pour un troisieme
je continue mes recherches pour voir si c'est entre c2 et c3 ou si c'est pour un double ou un triple

apparement c'est juste entre c2 et c3
 
Dernière édition:

Membres actuellement en ligne

Statistiques des forums

Discussions
312 294
Messages
2 086 896
Membres
103 404
dernier inscrit
sultan87