Ecrire sur la premiere ligne vide

Résolu

gislain99 -
gislain99 - 12 sept. 2013 à 18:25

Bonjour,
j'ai une feuille Excel qui me sert de bon de livraison elle se numérote se nome
s'imprime et se range automatiquement j'ai crée une feuille "Récapitulatif" ou j'archive 5 données .

Ce code fonctionne très bien


'Worksheets("Récapitulatif").Range("A12").Value = Worksheets("Dem.").Range("R9").Value
'Worksheets("Récapitulatif").Range("C12").Value = Worksheets("Dem.").Range("C11").Value
'Worksheets("Récapitulatif").Range("F12").Value = Worksheets("Dem.").Range("N11").Value
'Worksheets("Récapitulatif").Range("I12").Value = Worksheets("Dem.").Range("C13").Value
'Worksheets("Récapitulatif").Range("L12").Value = Worksheets("Dem.").Range("N13").Value

je voudrais juste que l'enregistrement de ces 5 données prenne la première ligne vide c'est la que sa coince.

Ci joint mon code que je n'arrive pas a faire fonctionner


 'With Worksheets("Récapitulatif")
' Dim DerLigne As String
 'Dim Cell As Range
  ' DerLigne = Range("A65536").End(xlUp).Row + 1
   ' Cell(DerLigne, 1).Value = Worksheets("Dem.").Range("R9").Value
'End With

L'erreur est sur la ligne surligné

D'avance merci pour votre aide

Afficher la suite

A voir également:

Vba première ligne vide
Formate pour taxer client frigo vide ✓ - Forum Vos droits sur internet
Partager photos en ligne - Guide
Supprimer page word vide - Guide
Internat nourriture - Forum Loisirs / Divertissements
Mètre en ligne - Guide

6 réponses

Réponse 1 / 6

melanie1324 Messages postés 1504 Date d'inscription Statut Membre Dernière intervention 155

Bonjour,

il y a une erreur de syntaxe, tu as oublié le s à cell :

With Worksheets("Récapitulatif")
Dim DerLigne As String
Dim Cell As Range
DerLigne = Range("A65536").End(xlUp).Row + 1
Cells(DerLigne, 1).Value = Worksheets("Dem.").Range("R9").Value
End With

Réponse 2 / 6

Zoul67 Messages postés 1959 Date d'inscription Statut Membre Dernière intervention 149

Bonjour,

Derligne en chaîne de caractères,ça ne colle pas
With sert à ne pas répéter toute la syntaxe et quand on y fait appel, on ajoute un point :


With Worksheets("x")
 Dim DerLigne As Double
 DerLigne = .Range("A65536").End(xlUp).Row + 1
 .Cells(DerLigne, 1).Value = Worksheets("y").Range("R9").Value
End With

A+

Polux31 Messages postés 6917 Date d'inscription Statut Membre Dernière intervention 1 204

Slt,

Petite correction:
Dim DerLigne As Long ' et non double ...

;0)

Zoul67 Messages postés 1959 Date d'inscription Statut Membre Dernière intervention 149

Vraiment ?

Réponse 3 / 6

gislain99

Bonjour,
Ok j'ais corrigé mes erreur le seul souci est que les enregistrement ce font à
partir de la ligne 21 alors que mon tableau est vide a partir de la ligne 12.
et tous les enregistrement ce font sur la ligne 21 il ne prend pas de ligne vide
pour faire les enregistrement suivant il écrase toujours les données de la ligne 21.

Ci joint mon code complet


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim extension As String
Dim chemin As String, nomfichier As String
Dim style As Integer

  If [C11] = "" Then
     MsgBox "Veuiller saisir le nom de la société", vbExclamation, "Erreur de saisie"
     Cancel = False
   Exit Sub
 End If
 If [A20] = "" Then
     MsgBox "Veuiller saisir la désignation", vbExclamation, "Erreur de saisie"
     Cancel = False
   Exit Sub
 End If
ActiveSheet.Name = ("BL-") & Range("R9").Text 'renome la feuille
'Enregistrement info récapitulatif
 With Worksheets("Récapitulatif")
 Dim DerLigne As Long
 Dim Cell As Range
   DerLigne = Range("A65535").End(xlUp).Row + 1
    .Cells(DerLigne, 1).Value = Worksheets("Dem.").Range("R9").Value
    .Cells(DerLigne, 3).Value = Worksheets("Dem.").Range("C11").Value
    .Cells(DerLigne, 6).Value = Worksheets("Dem.").Range("N11").Value
    .Cells(DerLigne, 9).Value = Worksheets("Dem.").Range("C13").Value
    .Cells(DerLigne, 12).Value = Worksheets("Dem.").Range("N13").Value
End With
Sheets(Array(ActiveSheet.Name)).PrintOut Copies:=1, Collate:=False 'Impression
'Sheets(Array("Dem.", "Pré.", ActiveSheet.Name)).PrintOut Copies:=1, Collate:=False 'Impression
'Enregistrement du BL
Application.ScreenUpdating = False
ThisWorkbook.ActiveSheet.Copy
extension = ".xls"
chemin = "C:\Wartsïla"
nomfichier = ActiveSheet.Name & extension
Range("N13").Value = Range("N13").Value 'garde uniquement le texte lors de la sauvegarde ne copie pas la formule

With ActiveWorkbook
    .ActiveSheet.DrawingObjects(1).Delete
    .SaveAs Filename:=chemin & "\" & nomfichier
    .Close
End With

Range("n°_BL").Value = Range("n°_BL").Value + 1
'Vide toute les cellules
[A20] = ""
[A21] = ""
[C11] = ""
[C13] = ""
[I30] = ""
[I31] = ""
[M38] = ""
[M39] = ""
[N11] = ""
[N20] = ""
[N21] = ""
[O36] = ""
[O37] = ""
[O38] = ""
[O39] = ""
[[S39] = ""
[S40] = ""
[S41] = ""
End Sub

Zoul67 Messages postés 1959 Date d'inscription Statut Membre Dernière intervention 149

En ligne 20, ce n'est donc pas vraiment vide : juste un espace peut induire en erreur...

Réponse 4 / 6

gislain99

bonjour,
Le seul problème qu'il me reste a gérer est mon souci d'enregistrement sur la première ligne vide de ma feuille "récapitulatif".
les enregistrements commence a la ligne 21 alors que mon tableau est vide à partir de la ligne 12.
et même les enregistrement suivant ne ce range pas sur les lignes suivantes ils écrasent les données de la ligne 21 et ce range a sa place.

J'ai recréer une nouvelle feuille "récapitulatif" mais j'ais toujours le même problème je ne voie pas d'où peut venir mon erreur.

Ci joint mon code


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim extension As String
Dim chemin As String, nomfichier As String
Dim style As Integer

  If [C11] = "" Then
     MsgBox "Veuiller saisir le nom de la société", vbExclamation, "Erreur de saisie"
     Cancel = False
   Exit Sub
 End If
 If [A20] = "" Then
     MsgBox "Veuiller saisir la désignation", vbExclamation, "Erreur de saisie"
     Cancel = False
   Exit Sub
 End If
ActiveSheet.Name = ("BL-") & Range("R9").Text 'renome la feuille

Worksheets("Dem.").Range("C11").Value = Feuil1.Range("C11").Value
Worksheets("Dem.").Range("N11").Value = Feuil1.Range("N11").Value
Worksheets("Dem.").Range("C13").Value = Feuil1.Range("C13").Value
Worksheets("Dem.").Range("R9").Value = Feuil1.Range("N°_BL").Value
Worksheets("Dem.").Range("N13").Value = Feuil1.Range("N13").Value

Worksheets("Pré.").Range("C11").Value = Feuil1.Range("C11").Value
Worksheets("Pré.").Range("N11").Value = Feuil1.Range("N11").Value
Worksheets("Pré.").Range("C13").Value = Feuil1.Range("C13").Value
Worksheets("Pré.").Range("R9").Value = Feuil1.Range("N°_BL").Value
Worksheets("Pré.").Range("N13").Value = Feuil1.Range("N13").Value

'Enregistrement info récapitulatif
 With Worksheets("Récapitulatif")
 Dim DerLigne As Long
 Dim Cell As Range
   DerLigne = Range("A65535").End(xlUp).Row + 1
    .Cells(DerLigne, 1).Value = Feuil1.Range("R9").Value
    .Cells(DerLigne, 3).Value = Feuil1.Range("C11").Value
    .Cells(DerLigne, 6).Value = Feuil1.Range("N11").Value
    .Cells(DerLigne, 9).Value = Feuil1.Range("C13").Value
    .Cells(DerLigne, 12).Value = Feuil1.Range("N13").Value
End With
Sheets(Array(ActiveSheet.Name)).PrintOut Copies:=1, Collate:=False 'Impression
'Sheets(Array("Dem.", "Pré.", ActiveSheet.Name)).PrintOut Copies:=1, Collate:=False 'Impression
'Enregistrement du BL
Application.ScreenUpdating = False
ThisWorkbook.ActiveSheet.Copy
extension = ".xls"
chemin = "C:\Wartsïla"
nomfichier = ActiveSheet.Name & extension
Range("N13").Value = Range("N13").Value 'garde uniquement le texte lors de la sauvegarde ne copie pas la formule

With ActiveWorkbook
    .ActiveSheet.DrawingObjects(1).Delete
    .SaveAs Filename:=chemin & "\" & nomfichier
    .Close
    
 'Vide toute les cellules Feuil1
End With
Range("n°_BL").Value = Range("n°_BL").Value + 1
[A20] = ""
[A21] = ""
[A22] = ""
[A23] = ""
[A24] = ""
[A25] = ""
[A26] = ""
[A27] = ""
[A28] = ""
[A29] = ""
[A30] = ""
[A31] = ""
[A32] = ""
[A33] = ""
[A34] = ""
[A35] = ""
[A36] = ""
[A37] = ""
[A38] = ""
[A39] = ""
[A40] = ""
[A41] = ""
[A42] = ""
[A43] = ""
[A44] = ""
[C11] = ""
[C13] = ""
[I20] = ""
[I21] = ""
[I22] = ""
[I23] = ""
[I24] = ""
[I25] = ""
[I26] = ""
[I27] = ""
[I28] = ""
[I29] = ""
[I30] = ""
[I31] = ""
[I32] = ""
[I33] = ""
[I34] = ""
[I35] = ""
[I36] = ""
[I37] = ""
[I38] = ""
[I39] = ""
[I40] = ""
[I41] = ""
[I42] = ""
[I43] = ""
[I44] = ""
[M20] = ""
[M21] = ""
[M22] = ""
[M23] = ""
[M24] = ""
[M25] = ""
[M26] = ""
[M27] = ""
[M28] = ""
[M29] = ""
[M30] = ""
[M31] = ""
[M32] = ""
[M33] = ""
[M34] = ""
[M35] = ""
[M36] = ""
[M37] = ""
[M38] = ""
[M39] = ""
[M40] = ""
[M41] = ""
[M42] = ""
[M43] = ""
[M44] = ""
[N11] = ""
[N20] = ""
[N21] = ""
[N22] = ""
[N23] = ""
[N24] = ""
[N25] = ""
[N26] = ""
[N27] = ""
[N28] = ""
[N29] = ""
[N30] = ""
[N31] = ""
[N32] = ""
[N33] = ""
[N34] = ""
[N35] = ""
[N36] = ""
[N37] = ""
[N38] = ""
[N39] = ""
[N40] = ""
[N41] = ""
[N42] = ""
[N43] = ""
[N44] = ""
[O20] = ""
[O21] = ""
[O22] = ""
[O23] = ""
[O24] = ""
[O25] = ""
[O26] = ""
[O27] = ""
[O28] = ""
[O29] = ""
[O30] = ""
[O31] = ""
[O32] = ""
[O33] = ""
[O34] = ""
[O35] = ""
[O36] = ""
[O37] = ""
[O38] = ""
[O39] = ""
[O40] = ""
[O41] = ""
[O42] = ""
[O43] = ""
[O44] = ""
[S20] = ""
[S21] = ""
[S22] = ""
[S23] = ""
[S24] = ""
[S25] = ""
[S26] = ""
[S27] = ""
[S28] = ""
[S29] = ""
[S30] = ""
[S31] = ""
[S32] = ""
[S33] = ""
[S34] = ""
[S35] = ""
[S36] = ""
[S37] = ""
[S38] = ""
[S39] = ""
[S40] = ""
[S41] = ""
[S42] = ""
[S43] = ""
[S44] = ""

 'Vide toute les cellules Feuil2
Feuil2.Range("C11").MergeArea.ClearContents
Feuil2.Range("N11").MergeArea.ClearContents
Feuil2.Range("C13").MergeArea.ClearContents
Feuil2.Range("N13").MergeArea.ClearContents
Feuil2.Range("R9").MergeArea.ClearContents

'Vide toute les cellules Feuil3
Feuil3.Range("C11").MergeArea.ClearContents
Feuil3.Range("N11").MergeArea.ClearContents
Feuil3.Range("C13").MergeArea.ClearContents
Feuil3.Range("N13").MergeArea.ClearContents
Feuil3.Range("R9").MergeArea.ClearContents

End Sub
'Oblige la saisie en Majuscule dans la colonne O de la ligne 20 à 44
Private Sub Worksheet_()
For Each maj In [O20:O44] 'plage a traitée
Application.ScreenUpdating = False
If maj <> "" Then
maj.Select
maj = UCase(maj)
ActiveCell = maj
End If
Next
Application.ScreenUpdating = True
Range("O20").Select
End Sub

Discussions similaires

masquer l'écran pendant Traitements par macros Excel

Tester si une cellule contient un mot

copier une plage de cellule ( range) sur un autre fichier excel

Type d'argument ByRef incompatible

Supprimer contenu partiel de cellule texte

Erreur de Compilation : Else sans If

Votre réponse

Discussions similaires