Discussion :

[Phyvon61]

Bonjour à tous,
Je n'arrive pas à écrire une macro qui fonctionne pour coller la valeur de 5 cellules de la même ligne d'une feuille1 dans un tableau d'une feuille2.
Le problème est que ce tableau est assimilé à une base de donnée est ces cellules doivent se coller à la première ligne vide.

Pour préciser:

Feuille1
Date Heure Nom Qté Table
Les valeurs des cellules qui sont en dessous doivent être copiées dans le tableau de la feuille2 qui a le même intitulé de colonnes mais ou les lignes se remplissent au fur et à mesure.

Voici la macro que j'ai déja faite:
Sub Saisieréservation()
'Atteindre le formulaire et mémoriser les données
Sheets("Plan de salles").Select
Range("B37").Select
Selection.Copy
'Test pour déterminer la ligne où coller les infos dans le tableau
Sheets("Base de données").Select
valeurE4 = Range("E4").Value
If valeurE4 = "" Then
Range("E4").Select
Else
Range("E3").Select
Selection.End(xlDown).Select
ligne_active_base = ActiveCell.Row
Range("E" & ligne_active_base + 1).Select
End If
'Memorise le n° de la ligne où coller les données
ligne_active_base = ActiveCell.Row
'Collage avec transposition
Range("E" & ligne_active_base).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
'Rendre vierge le formulaire
Sheets("Plan de salles").Select
Range("B37").Select
Selection.ClearContents
Range("B37").Select
'Retourner dans le tableau
Sheets("Base de données").Select
Range("E4").Select
'Atteindre le formulaire et mémoriser les données
Sheets("Plan de salles").Select
Range("C37").Select
Selection.Copy
'Test pour déterminer la ligne où coller les infos dans le tableau
Sheets("Base de données").Select
valeurF4 = Range("F4").Value
If valeurE4 = "" Then
Range("F4").Select
Else
Range("F3").Select
Selection.End(xlDown).Select
ligne_active_base = ActiveCell.Row
Range("F" & ligne_active_base + 1).Select
End If
'Memorise le n° de la ligne où coller les données
ligne_active_base = ActiveCell.Row
'Collage avec transposition
Range("F" & ligne_active_base).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
'Rendre vierge le formulaire
Sheets("Plan de salles").Select
Range("C37").Select
Selection.ClearContents
Range("C37").Select
'Retourner dans le tableau
Sheets("Base de données").Select
Range("E4").Select
'Atteindre le formulaire et mémoriser les données
Sheets("Plan de salles").Select
Range("D37").Select
Selection.Copy
'Test pour déterminer la ligne où coller les infos dans le tableau
Sheets("Base de données").Select
valeurG4 = Range("G4").Value
If valeurE4 = "" Then
Range("G4").Select
Else
Range("G3").Select
Selection.End(xlDown).Select
ligne_active_base = ActiveCell.Row
Range("G" & ligne_active_base + 1).Select
End If
'Memorise le n° de la ligne où coller les données
ligne_active_base = ActiveCell.Row
'Collage avec transposition
Range("G" & ligne_active_base).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
'Rendre vierge le formulaire
Sheets("Plan de salles").Select
Range("D37").Select
Selection.ClearContents
Range("D37").Select
'Retourner dans le tableau
Sheets("Base de données").Select
Range("E4").Select
'Atteindre le formulaire et mémoriser les données
Sheets("Plan de salles").Select
Range("E37").Select
Selection.Copy
'Test pour déterminer la ligne où coller les infos dans le tableau
Sheets("Base de données").Select
valeurH4 = Range("H4").Value
If valeurH4 = "" Then
Range("H4").Select
Else
Range("H3").Select
Selection.End(xlDown).Select
ligne_active_base = ActiveCell.Row
Range("H" & ligne_active_base + 1).Select
End If
'Memorise le n° de la ligne où coller les données
ligne_active_base = ActiveCell.Row
'Collage avec transposition
Range("H" & ligne_active_base).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
'Rendre vierge le formulaire
Sheets("Plan de salles").Select
Range("E37").Select
Selection.ClearContents
Range("E37").Select
'Retourner dans le tableau
Sheets("Base de données").Select
Range("E4").Select
'Atteindre le formulaire et mémoriser les données
Sheets("Plan de salles").Select
Range("F37").Select
Selection.Copy
'Test pour déterminer la ligne où coller les infos dans le tableau
Sheets("Base de données").Select
valeurI4 = Range("I4").Value
If valeurI4 = "" Then
Range("I4").Select
Else
Range("I3").Select
Selection.End(xlDown).Select
ligne_active_base = ActiveCell.Row
Range("I" & ligne_active_base + 1).Select
End If
'Memorise le n° de la ligne où coller les données
ligne_active_base = ActiveCell.Row
'Collage avec transposition
Range("I" & ligne_active_base).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
'Rendre vierge le formulaire
Sheets("Plan de salles").Select
Range("F37").Select
Selection.ClearContents
Range("F37").Select
'Retourner dans le tableau
Sheets("Base de données").Select
Range("E4:I1000").Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Bold = False
'Atteindre le formulaire et mémoriser les données
Sheets("Plan de salles").Select
Range("B37").Select



End Sub

Merci pour votre aide

Je suis sous Excel 2007

[Gorfael]

Salut Phyvon61 et le forum
Bienvenue
# dans la barre du menu sert à passer du code
À quoi sert de donner un code qui ne fonctionne pas ? Donne plutôt le résultat que tu veux obtenir en fonction des données
Ce que je crois comprendre :
tu veux copier (sauf l'encadrement) les cellules B37 à F37 de la feuille "Plan des salles" dans .... la première ligne vide en E de la feuille ""Base de données" (de E à I) ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Saisieréservation()
'Déclarations ---------------------
Dim F_D As Worksheet 'Départ
Dim F_A As Worksheet 'arrivée
Dim x
'initialisation -------------------
Set F_D = Sheets("A")    'Plan de salles")
Set F_A = Sheets("B")     'ase de données")
'Copie ----------------------------
F_D.Range("B37:F37").Copy
F_A.Select
F_A.Range("E" & F_A.Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteAllExceptBorders
'Mise en forme --------------------
With F_A.Range("E4:I" & F_A.Range("E" & F_A.Rows.Count).End(xlUp).Row).Font
        .Name = "Arial"
        .Size = 10
        .ColorIndex = xlAutomatic
        .Bold = False
End With
'effacement ----------------------
F_D.Activate
Range("B37:F37").ClearContents
[B37].Select
End Sub

Ce qui me fait hésiter c'est que tu utilises Transpose à vrai (sur une cellule, ça ne sert à rien)

Pour le format des cellules réceptrices, ne mets que ce qui a une raison d'être.
Explique meiux ton problème
A+