Copier une cellule à la ligne suivante si celles ci contient

bonjour,

voici mon système

je souhaite faire la copier de toutes les cellules que vous retrouvez dans mon systeme à la ligne suivante si la ligne actuelle est déjà pleine.

Merci beaucoup de votre aide

Sub enregistrer()

Dim i As Integer

i = 8

If Sheets("Feuil6").Range("A" & i).Value = "" Then

Sheets("Feuil6").Range("B4").Copy
With Sheets("suivi")
.Range("F" & i).PasteSpecial Paste:=xlPasteValues
End With

Sheets("Feuil6").Range("D4").Copy
With Sheets("suivi")
.Range("G" & i).PasteSpecial Paste:=xlPasteValues
End With
Sheets("Feuil6").Range("B1").Copy
With Sheets("suivi")
.Range("B" & i).PasteSpecial Paste:=xlPasteValues
End With
Sheets("Feuil6").Range("B2").Copy
With Sheets("suivi")
.Range("A" & i).PasteSpecial Paste:=xlPasteValues
End With
Sheets("Feuil6").Range("B3").Copy
With Sheets("suivi")
.Range("C" & i).PasteSpecial Paste:=xlPasteValues
End With

Sheets("Feuil6").Range("E10").Copy
With Sheets("suivi")
.Range("D" & i).PasteSpecial Paste:=xlPasteValues
End With

Sheets("Feuil6").Range("e30").Copy
With Sheets("suivi")
.Range("E" & i).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Else
If Sheets("Feuil6").Range("A" & i).Value <> "" Then

'si ma cellule Range("A" & i) n'est pas vide alors enregistrer mes données (que je retrouves juste au dessus dans le systeme) à la ligne suivante


End If
End If

End Sub

Bonjour,

Voici une proposition de code :

Sub enregistrer()

Dim f6 as worksheet, fsuivi as worksheet
Dim rsaisie as Range
Dim i%

Set f6 = Sheets("Feuil6")
Set fsuivi = Sheets("suivi")

with f6
    'Set rsaisie = Range("B1:B4, D4, E10, E30") '<<<<<< (pour effacer saisie) ATTENTION : A ADAPTER
    .exportasfixedformat type:=xltypepdf, filename:=thisworkbook.path & "\" & format(now, "YYMMDD-HHMMSS") & ".pdf", ignoreprintareas:=false
end with

with fsuivi
    i = .cells(.rows.count, 1).end(xlup).row + 1
    .Range("A" & i).value = f6.Range("B2").value
    .Range("B" & i).value = f6.Range("B1").value
    .Range("C" & i).value = f6.Range("B3").value
    .Range("D" & i).value = f6.Range("E10").value
    .Range("E" & i).value = f6.Range("E30").value
    .Range("F" & i).value = f6.Range("B4").value
    .Range("G" & i).value = f6.Range("D4").value
End with

'rsaisie.clearcontents 'efface les saisies

End Sub

J'ai même rajouté quelques lignes pour :
- éditer un PDF (si le présent fichier sert à émettre des factures, comme j'en ai le sentiment)
- effacer les cellules de saisie automatiquement (attention, il faudra supprimer les lignes si ce n'est pas nécessaire)

Il faudra éventuellement modifier le chemin (et le nom de fichier) du pdf et si possible nommer les cellules de Feuil6 (Date, ...) afin d'éviter au maximum les bugs.

Cdlt,

super

je vous remercie! En plus, cela évite les répétitions.

De plus comment faire si je veux exporter en un autre classeur excel ?

La dénomination des cellules est à faire en vba ? ou y a t'il un autre moyen ?

Merci d'avance

Bonjour,

!

Non, il faut juste aller dans le gestionnaire de noms (onglet Formules normalement) et définir un nom. Sinon, vous vous placez sur la cellule à nommer. Ensuite sa référence apparait dans la barre de référence (à gauche de la barre de formules). Vous saisissez directement le nom désiré à cet endroit et voilà !

Mais il faudra cependant (pas obligatoire mais très pratique) corriger le nom dans le code ensuite (remplacer B2 par Date par exemple si vous nommez B2 Date).

Exporter dans un autre classeur ? C'est-à-dire ? Est-ce que je peux comprendre de quel type de fichier il s'agit ?

Bonjour,

d'accord, c'est compris en ce qui concerne la dénomination des cellules. ;)

Sur le code que vous m'avez donné, vous avez fait un export en pdf.

ma "Feuil6" est un modèle avec des données qui sont enregistrées sur la feuille "suivi". Lorsque j'ai remplit ma Feuil6, je veux alors en créer une copie dans un nouveau excel.

est ce que je suis claire ? ou pas ...

merci d'avance :)

Oui, c'est clair mais y a-t-il un intérêt ? Justement, le fait d'avoir un pdf ne suffirait-il pas ?

C'est quoi comme fichier, vous faites un suivi de quoi ? S'il s'agit de factures comme je le pressens, il n'y a aucune utilité à cumuler les ficihers excel.

C'est pour la création de roulement de cars. Je suis à la sncf. Les roulements sont souvent modifiés. le fait d'en garder une copie , me permet de retourner dessus et de la modifier. En effet, pour le coté routier aucun logiciel est utilisé à part excel alors il faut que je travaille sur ceux ci pour éviter les saisies.

voici mon fichier, ce n'est qu'un début... il reste encore énormément de travail dessus

D'accord... En tout cas, voici les lignes pour copier la feuille roulement dans un nouveau classeur et pour l'enregistrer.

Sub CopieRoulement()

Sheets("roulement").copy 'copie dans un nouveau classeur
Activeworkbook.close savechanges:=true, filename:="ROULEMENT " & format(now, "YYMMDD") 'ferme et sauvegarde ce nv classeur (nom à adapter)

end sub

Je vais essayer ! Merci beaucoup pour votre aide !!! :)

Je vous en prie !

Bonne continuation,

Sheets("roulement").copy 'copie dans un nouveau classeur

Activeworkbook.close savechanges:=true, filename:="ROULEMENT " & format(now, "YYMMDD") 'ferme et sauvegarde ce nv classeur (nom à adapter)

end sub

Imaginons que je veux enregistrer le nom du fichier dans une cellule du fichier modèle avec un lien hypertexte (afin de le retrouver plus facilement) est ce que cela est il possible ou pas ?

Merci beaucoup

Bonjour,

Vous pouvez décider de l'endroit où enregistrer le fichier et éventuellement ajouter un lien hypertext. Voici un essai

Sub CopieRoulement()

Dim chemin$

chemin = thisworkbook.path & "ROULEMENT " & format(now, "YYMMDD") & ".xlsx" '<<< à adapter à volonté

With Sheets("roulement")
    .copy 'copie dans un nouveau classeur
    Activeworkbook.close savechanges:=true, filename:=chemin 'ferme et sauvegarde ce nv classeur (nom à adapter)
    .Hyperlinks.Add Anchor:=.Range("A1"), Address:=chemin, _
        ScreenTip:=chemin, TextToDisplay:="Ouvrir le dernier fichier :" & "ROULEMENT " & format(now, "YYMMDD")
    '<<< adapter à volonté
End With

end sub

Cdlt,

Merci beaucoup