Copier / Coller valeur / Transposer / Sans cellule vide

Le 30/09/2017 à 14:12

Bonjour à tous, tout fraichement arrivé sur le forum et débutant en VBA, (ce sont mes premières macros), je sollicite votre aide pour résoudre mon problème qui est le suivant :

J'ai dans une première feuille nommé : "TBL B" pour tableau de bord des données qui seront rentrés par l'utilisateur.

C'est données sont ensuite envoyés dans une autre feuille nommé "Data" via une macro déclenché par un bouton enregistrer. C'est justement cette macro en question qui me pose problème.

La macro doit en premier lieu se rendre dans la feuille data pour inséré une nouvelle ligne à partir de la 3ème.

Ensuite retourner dans la feuille TBL B, copier la colonne C (excepté la cellule C14).

Retourner dans le data et coller les données dans la nouvelle ligne créé, sans mise en forme (soit coller valeur) tout en les transposant et sans copié les cellule vide ni la cellule C14.

J'arrive à le faire en enregistrement la macro mais forcément le code est long et la macro rame même si elle marche. Je voudrais donc savoir si il est possible (et je suis presque sur que oui) d’alléger ma macro.

Voici le code :

Sub Enregistrer()

Range("C4").Select

Selection.Copy

Application.CutCopyMode = False

Sheets("Data").Select

Rows("3:3").Select

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Sheets("TBL B").Select

Range("C4").Select

Selection.Copy

Sheets("Data").Select

Range("A3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("TBL B").Select

Range("C6").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Data").Select

Range("B3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("TBL B").Select

Range("C8").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Data").Select

Range("C3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("TBL B").Select

Range("C10").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Data").Select

Range("D3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("TBL B").Select

Range("C12").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Data").Select

Range("E3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("TBL B").Select

Range("C16").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Data").Select

Range("F3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("TBL B").Select

Range("C18").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Data").Select

Range("G3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("TBL B").Select

ActiveWindow.SmallScroll Down:=13

Range("C22").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Data").Select

Range("H3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("TBL B").Select

Range("C24").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Data").Select

Range("I3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("TBL B").Select

Range("C28").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Data").Select

Range("J3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("TBL B").Select

Range("C30").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Data").Select

Range("K3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("M3").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "=MONTH(RC[-11])"

Range("K:K,I:I").Select

Range("I1").Activate

ActiveWindow.ScrollColumn = 1

Range("K:K,I:I,C:C,B:B").Select

Range("B1").Activate

Selection.NumberFormat = "m/d/yyyy"

Cells.Select

Sheets("TBL B").Select

Range("C4").Select

End Sub

Je vous remercie d'avance

Le 30/09/2017 à 14:37

Bonjour,

à tester,

Sub Enregistrer()
'excepter la cellule C14
Sheets("Data").Rows("3:3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
LastRow = Sheets("TBL B").Cells(Rows.Count, 3).End(xlUp).Row

For i = 4 To LastRow
 If Sheets("TBL B").Range("C" & i) <> 0 And i <> 14 Then
   n = n + 1
   Sheets("Data").Cells(3, n).Value = Sheets("TBL B").Cells(i, "C").Value
 End If
Next

End Sub
Le 30/09/2017 à 15:03

Bonjour sabV et merci beaucoup elle marche nickel

Le 30/09/2017 à 15:24

Merci pour ce retour, au plaisir!

pour clôturer le fil, cliquer sur le bouton V vert du post à coté du bouton EDITER, merci!

Le 30/09/2017 à 16:00

J'ai un deuxième problème mais pas par rapport au macro cette fois ...

Dans le même tableur, une fois les données enregistrer en Data, elles sont triées par mois dans une feuille nommé : C ds pour classement de données.

Ensuite il y a une feuille par mois qui va directement chercher les données, sauf que je pensais que tout marchais très bien mais mystère j'obtiens une erreur car il y a une date identique mais sur un autre véhicule.

Il s'agit d'un planning automatique d'utilisation de véhicules et de conducteurs.

Les plages nommés sont les suivantes :

BC_JAN : $C$1 : $C$1000

COND1_JAN : $F$1 : $F$1000

COND2_JAN : $J$1 : $J$1000

COND3_JAN : $L$1 : $L$1000

DATDIF1_JAN : $K$1 : $K$1000

DATDIF2_JAN : $M$1 : $M$1000

Le but de la formule est de renvoyer le choix du conducteur sauf qu'il est possible que l'utilisateur est sélectionné deux choix de conducteur différents à des dates différentes.

Je m'explique, l'utilisateur rentre l'utilisation d'un véhicule du 01/01/17 au 15/01/17 avec un choix d'un seul conducteur. Il ajoute également que le 01/01/17 uniquement il y aura deux conducteur. Étant placé le 01/01/17, nous devons donc avoir comme résultat deux conducteurs.

Ce qui nous donne pour la formule

=SI(C7="";"";SI(INDEX(DATDIF2_JAN;EQUIV(C7;BC_JAN))=C$5;INDEX(COND3_JAN;EQUIV(C7;BC_JAN));SI(INDEX(DATDIF1_JAN;EQUIV(C7;BC_JAN))=C$5;INDEX(COND2_JAN;EQUIV(C7;BC_JAN));INDEX(COND1_JAN;EQUIV(C7;BC_JAN)))))

J'ai beau chercher je n'arrive pas à comprendre pourquoi il me renvois erreur. Si je supprime la ligne avec l'utilisation du véhicule 55.1 l'erreur n'apparaît plus...

De plus lorsque je fait F9 sur la formule : INDEX(COND1_JAN;EQUIV(C7;BC_JAN)) j'obtiens N/A alors que je devrais obtenir 2 Cond Jour

C'est noté, doit je recréer un topic pour mon deuxième problème ?

Le 30/09/2017 à 16:31

Bonjour,

C'est noté, doit je recréer un topic pour mon deuxième problème ?

oui, vous auriez plus de chance d'avoir une réponse sur un nouveau un topic, car il y aura plus de personnes à lire votre problème,

ps/ pour une question comme ça, il faudrait joindre un fichier.

Rechercher des sujets similaires à "copier coller valeur transposer vide"