Saise automatique d'un tableau et retour à la ligne automati

Bonjour à tous,

J'ai un petit problème à vous soumettre.

Je joint un petit fichier.

Voila, j'ai un tableau avec des données dans la feuille1. Ces données changent tous les jours et c'est moi qui les saisi dans le tableau.

A l'aide d'une macro je souhaite transférer ces données sur la feuille2 pour qu'elles soient utilisables et en faire des analyses.

Les données à saisir en auto dans la feuille2 sont les cases en bleues et en rose.

Comme je souhaite pouvoir analyser ces données, il faut absolument que chaque saisie se face les une en dessous des autres (comme un retour à la ligne).

C'est cette partie qui me pose le plus de problème, le retour à la ligne ... sans bien évidemment écraser les données précédentes.

Quel est le code qui permet de faire ce retour à la ligne sans écraser ce qui a été fait avant?

Voili voilou,

Le premier qui trouve gagne toute ma gratitude et ma reconnaissance!

Merci d'avance à tous et bonne journée.

Patrice87

21exo1.xlsx (8.62 Ko)

Bonsoir Patrice,

Pourquoi utiliser deux feuilles (une pour la saisie et l'autre pour le stockage) ?

Cela ne procure que de faibles avantages (avoir une feuille de saisie vierge chaque jour) par rapport à de gros inconvénients (tu décris le premier, mais ce ne sera peut-être pas le seul).

Pour commencer, tu peux essayer d'ajouter le bouton Formulaire à ta Barre d'Outils Accès Rapide : ça peut suffire à ton bonheur avec un peu de chance !

Cordialement, Daniel

Bonjour,

Une proposition

20patrice87.zip (14.59 Ko)

A+

Salut,

Voici une macro qui examine les données de la Feuille1 et les transfère sur la feuille2 si le code couleur correspond.

Sub Transfert()
Dim F1 As Worksheet, F2 As Worksheet
Dim Ligne1 As Long, Ligne2 As Long

Set F1 = Sheets("Feuil1")
Set F2 = Sheets("Feuil2")

Ligne2 = F2.Range("A" & F2.Rows.Count).End(xlUp).Row
Ligne1 = 4

Do While F1.Range("A" & Ligne1) <> ""
  If F1.Range("B" & Ligne1).Interior.ColorIndex = 15 Or F1.Range("B" & Ligne1).Interior.ColorIndex = 24 Then
    Ligne2 = Ligne2 + 1
    F2.Range("A" & Ligne2) = F1.Range("B1")
    F1.Range("A" & Ligne1 & ":E" & Ligne1).Copy
    F2.Range("B" & Ligne2 & ":F" & Ligne2).PasteSpecial (xlPasteAll)
  End If
  Ligne1 = Ligne1 + 1
Loop

Set F1 = Nothing
Set F2 = Nothing
End Sub

A+

H

Bonjour Daniel,

Dans un premier temps merci beaucoup pour ta réponse.

Je vais essayer ce que tu me proposes et gratter un peu de ce coté là.

Pourquoi deux feuille??? Et bien parce que mon tableau devra être bien plus compliqué que celui du fichier Exo1avec plus de colonnes et de lignes. Il aura également des MFC et des formules. Ce tableau doit être visuel et partagé par un grand nombre de personnes et je dois archiver chaque jours ce qui est dans ce tableau.

voilà pour la petite explication.

Merci mille fois

Patrice

bonjour LordNelson45,

Merci pour cette macro mais elle ne fonctionne pas.

Dans la feuille 2 je retrouve un copier coller du tableau de la feuille 1 avec la mise en forme.

Je souhaite avoir que les valeurs des cases et pas la mise en forme.

il manque aussi la date.

merci beaucoup


Bonjour Frangy,

Merci, C'est exactement ça mais il manque la saisie de la date.

Peut on la rajouter?

Bonjour Patrice87,

Tout d'abord, je veux te dire que me m'associe à mes camarades de jeu pour te rappeler que les intervenants méritent un minimum de considération, ne serait-ce que pour l'aide qu'il apportent bénévolement et gracieusement.

Et le mini..mini..minimum, c'est de faire un retour à leurs réponses.

Si cela va sans dire, ça va encore mieux en le disant ... et ça soulage !

Les choses sérieuses passées, venons-en à l'amusement :

Sub Transferer()
Dim WsS As Worksheet, WsC As Worksheet
Dim DerLigS As Long, DerLigC As Long, L As Long
    Set WsS = Worksheets("Feuil1")
    Set WsC = Worksheets("Feuil2")
    DerLigS = WsS.Range("A" & Rows.Count).End(xlUp).Row
    If DerLigS > 3 Then
        DerLigC = WsC.Range("B" & Rows.Count).End(xlUp).Row
        For L = 4 To DerLigS
            WsS.Range("A" & L).Resize(, 5).Copy
            WsC.Cells(L - 2, 1) = WsS.Range("B1").Value
            WsC.Cells(DerLigC + L - 3, 2).Resize(, 5).PasteSpecial xlPasteValues
        Next L
        WsC.Activate
        WsC.Cells(DerLigC + 1, 1).Select
        Application.CutCopyMode = False
    End If
    Set WsC = Nothing: Set WsS = Nothing
End Sub

A+

Patrice tu as un sérieux problème de comportement :

Merci pour cette macro mais elle ne fonctionne pas

Or tu dis juste après :

Dans la feuille 2 je retrouve un copier coller du tableau de la feuille 1 avec la mise en forme.

Ce qui prouve que la macro fonctionne !

Je souhaite avoir que les valeurs des cases et pas la mise en forme

Je passe sur la grammaire mais je t'invite à lire ta demande.

Quand as-tu demandé de ne pas reproduire la mise en forme ?

Et enfin :

il manque aussi la date

C'est faux !

Je regrette le 1/4 d''heure passé à chercher une solution à ton problème...

Rechercher des sujets similaires à "saise automatique tableau retour ligne automati"