selectionner la premiere cellule vide de la colonne A(volet figer)

julie999

XLDnaute Occasionnel
bonjour
je cherche le code vba pour sélectionner la première cellule vide de la colonne A a partir de de de la cellule A7 puis
Range("C23:L26").Select
Selection.Copy
Range("A8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Julie

PS:attention les volets sont figer(a conserver)
 

Pièces jointes

  • Classeur1test.xlsx
    24.1 KB · Affichages: 121
  • Classeur1test.xlsx
    24.1 KB · Affichages: 113
  • Classeur1test.xlsx
    24.1 KB · Affichages: 119

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : selectionner la premiere cellule vide de la colonne A(volet figer)

Bonsoir julie999,

Pas sûr d'avoir bien compris la demande. Essayez le code:
Copie C23:L26 vers la première cellule vide de la colonne A après la cellule A7
VB:
Sub Test()
Dim i As Long, n As Long
   With Sheets("Reporting complet")
      n = .Cells(.Rows.Count, 1).End(xlUp).Row
      For i = 8 To n
         If .Cells(i, 1) = "" Then Exit For
      Next i
      .Range("C23:L26").Copy
      .Cells(i, 1).PasteSpecial Paste:=xlPasteValues
   End With
Application.CutCopyMode = False
End Sub

ou bien:
Copie C23:L26 vers la première cellule vide après la dernière cellule non vide de la colonne A après la cellule A7
VB:
Sub Test2()
Dim n As Long
   With Sheets("Reporting complet")
      n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
      If n < 8 Then n = 8
      .Range("C23:L26").Copy
      .Cells(n, 1).PasteSpecial Paste:=xlPasteValues
   End With
Application.CutCopyMode = False
End Sub
 
Dernière édition:

julie999

XLDnaute Occasionnel
Re : selectionner la premiere cellule vide de la colonne A(volet figer)

bonsoir mapomme
en faite dans mon fichier la réelle plage a copier est :
Sheets("Réception").Select
Range("AG9:CR11").copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


donc ton code serait

Sub Test()
Dim i As Long, n As Long
With Sheets("Reporting complet")
n = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 8 To n
If .Cells(i, 1) = "" Then Exit For
Next i
Sheets("Réception").Select
Range("AG9:CR11").copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
End Sub

mais ça ne fonctionne pas comme ça j'ai du zappé quelque chose
Julie
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : selectionner la premiere cellule vide de la colonne A(volet figer)

(re)bonsoir,

Je pense que c'est plutôt le 2 ième code qu'il faut utiliser dans votre cas:

VB:
Sub Test3()
Dim n As Long
   With Sheets("Reporting complet")
      n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
      If n < 8 Then n = 8
      Sheets("Réception").Range("AG9:CR11").Copy
      .Cells(n, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      .Cells(n, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   End With
Application.CutCopyMode = False
End Sub
 

julie999

XLDnaute Occasionnel
Re : selectionner la premiere cellule vide de la colonne A(volet figer)

re ma pomme ,le fil
parfait ça fonctionne c'est super
tu aurais pas une idée pour éviter les doublons par rapport a la date
en faite la macro doit se faire normalement une fois par jour
mais si il y a des modifications il macro va copier a nouveaux les données
le but
interroger par rapport a la date si elle est déjà présente dans la colonne A de la feuille reporting complet si oui indiquer un message demandant d'annuler l'action ou d’écraser les données et conserver les dernières bien sur
aurais tu une idée

merci Julie
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : selectionner la premiere cellule vide de la colonne A(volet figer)

Bonjour julie999,

Un essai dans le fichier joint avec le code:
VB:
Sub Test3()
Dim n As Long, xRep As Long
Dim xRow As Range, memeDate As Range

With Sheets("Reporting complet")
  ' pour chaque ligne de la zone à copier de la feuille réception
  For Each xRow In Sheets("Réception").Range("AG9:CR11").Rows
    ' recherche si la date de la ligne figure sur la feuille "Reporting complet"
    Set memeDate = Nothing
    Set memeDate = .Columns("a").Find(what:=xRow.Cells(1, 1).Value, after:=.Range("A1"), _
      LookIn:=xlValues, lookat:=xlWhole)
    If memeDate Is Nothing Then
      ' si elle n'y figure pas
      ' recherche de la 1ere ligne vide sur la feuille "Reporting complet"
      n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
      If n < 8 Then n = 8
      ' copie et collage de la ligne issue de la feuille "Réception"
      xRow.Copy
      .Cells(n, 1).PasteSpecial Paste:=xlPasteValues
      .Cells(n, 1).PasteSpecial Paste:=xlPasteFormats
    Else
      ' si la date figure déjà dans la feuille "Reporting complet", que faire ?
      xRep = MsgBox("L'enregistrement (" & Format(xRow.Cells(1, 1).Value, "dd mmm yyyy") & _
        ") à ajouter figure déjà dans la feuille 'Reporting complet'." & vbLf & vbLf & _
        "Doit-on écraser les anciennes valeurs (OK)" & vbLf & _
        "ou bien annuler la copie (Annuler) ?", _
        Buttons:=vbQuestion + vbOKCancel + vbDefaultButton2)
      If xRep = vbOK Then
        ' on désire écraser -> demande d'une confirmation
        xRep = MsgBox("Voulez-vous vraiment écraser les anciennes valeurs pour " & _
          Format(xRow.Cells(1, 1).Value, "dd mmm yyyy") & " ?", Buttons:=vbQuestion + _
          vbYesNo + vbDefaultButton2)
        If xRep = vbYes Then
          ' Confirmation = OK
          ' copie et collage de la ligne issue de la feuille "Réception"
          xRow.Copy
          .Cells(memeDate.Row, 1).PasteSpecial Paste:=xlPasteValues
          .Cells(memeDate.Row, 1).PasteSpecial Paste:=xlPasteFormats
        End If
      End If
    End If
  Next xRow
End With
Application.CutCopyMode = False
End Sub
 

Pièces jointes

  • julie999 v1.xlsm
    38.2 KB · Affichages: 53

julie999

XLDnaute Occasionnel
Re : selectionner la premiere cellule vide de la colonne A(volet figer)

bonjour mapomme
exelent cette macro
sauf que ce que j'ai oublier de te signaler
a chaque fois les dates sont identiques pour les 3 destinations et la macro est faite normalement une fois par jour la sécurité que tu propose servirait donc si il y a une modif a faire sur le fichier dans ce cas il écrase les ancienne données par rapport a la date mais ça tu l'avais bien compris
donc a chaque fois on a
16/12/2012 Sartrouville 11 11 11 11
16/12/2012 Londres 22 22 22 22
16/12/2012 Arvato 33 33 33 33
le lendemain on aura
17/12/2012 Sartrouville 33 33 33 33
17/12/2012 Londres 22 22 22 22
17/12/2012 Arvato 33 33 33 33
donc il y a un petit hic sur la securité
vois tu comment corrigé le code
en tous merci pour ton aide
Julie
bisou
 

julie999

XLDnaute Occasionnel
Re : selectionner la premiere cellule vide de la colonne A(volet figer)

bonjour
quel piste suivre pour modifier le code
' recherche si la date de la ligne figure sur la feuille "Reporting complet"
Set memeDate = Nothing
Set memeDate = .Columns("a").Find(what:=xRow.Cells(1, 1).Value, after:=.Range("A1"), _
LookIn:=xlValues, lookat:=xlWhole)
car chaque jour la date est indiquer 3 fois sur 3 lignes différentes
le message disant que la date figure deja ne devrait s'afficher qu'une seule fois
Julie
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : selectionner la premiere cellule vide de la colonne A(volet figer)

Bonsoir julie999,

Voir dans le fichier joint un nouvel essai.
VB:
Sub Test4()
Dim n As Long, xRep As Long, xRow As Range, memeDate As Range
Dim newDate As Range, aCopier As Boolean

Application.ScreenUpdating = False
With Sheets("Reporting complet")
'init
aCopier = False
n = .Cells(.Rows.Count, 1).End(xlUp).Row
If n < 8 Then n = 8
.Range(.Cells(8, 1), .Cells(n, 1)).NumberFormat = "General"
Sheets("Réception").Range("AG9:CR11").Columns(1).NumberFormat = "General"

  ' lecture de la date sur la feuille "réception"
  Set newDate = Sheets("Réception").Range("AG9")
  ' recherche si newDate existe dans la feuille "Reporting complet"
  Set memeDate = Nothing
  
  Set memeDate = .Columns("a").Find(What:=newDate, After:= _
    .Range("A1"), LookIn:=xlValues)   '  , lookat:=xlWhole
  If memeDate Is Nothing Then
    ' la date ne figure pas dans feuille "Reporting complet"
    aCopier = True
  Else
    'demande d'écrasement des vieilles données de "Reporting complet"
    xRep = MsgBox("La date '" & Format(newDate, _
          "dd mmm yyyy") & "' figure déjà dans la feuille " & _
          " 'Reporting complet'." & vbLf & vbLf & _
          "Doit-on écraser les anciennes valeurs (OK)" & vbLf & _
          "ou bien annuler la copie (Annuler) ?", _
          Buttons:=vbQuestion + vbOKCancel + vbDefaultButton2)
    If xRep = vbOK Then
      ' on désire écraser -> demande d'une confirmation
      xRep = MsgBox("Voulez-vous vraiment écraser les anciennes " & _
          "valeurs pour la date " & Format(newDate, "dd mmm yyyy") & _
          " ?", Buttons:=vbQuestion + vbYesNo + vbDefaultButton2)
      If xRep = vbYes Then
        aCopier = True
        ' boucle d'effacement
        memeDate.EntireRow.Delete
        Do
          Set memeDate = Nothing
          Set memeDate = .Columns("a").Find(What:=newDate, After:= _
              .Range("A1"), LookIn:=xlValues, LookAt:=xlWhole)
          If Not memeDate Is Nothing Then memeDate.EntireRow.Delete
        Loop Until memeDate Is Nothing
      End If
    End If
  End If
  
  If aCopier Then
    ' recherche de la 1ere ligne vide sur la feuille "Reporting complet"
    n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    If n < 8 Then n = 8
    ' copie et collage de la ligne issue de la feuille "Réception"
    Sheets("Réception").Range("AG9:CR11").Copy
    .Cells(n, 1).PasteSpecial Paste:=xlPasteValues
    .Cells(n, 1).PasteSpecial Paste:=xlPasteFormats
    ' tri selon la date
    n = .Cells(.Rows.Count, 1).End(xlUp).Row
    If n < 8 Then n = 8
    .Range(.Cells(8, 1), .Cells(n, "BL")).Sort key1:=.Cells(8, 1), Header:=xlNo
  End If
  
  'finalisation
  n = .Cells(.Rows.Count, 1).End(xlUp).Row
  If n < 8 Then n = 8
  .Range(.Cells(8, 1), .Cells(n, 1)).NumberFormat = "dd/mm/yyyy;@"
  Sheets("Réception").Range("AG9:CR11").Columns(1).NumberFormat = "dd/mm/yyyy;@"
End With
Application.CutCopyMode = False
Application.ScreenUpdating = False
End Sub
 

Pièces jointes

  • julie999 v3.xlsm
    37.4 KB · Affichages: 51
Dernière édition:

julie999

XLDnaute Occasionnel
Re : selectionner la premiere cellule vide de la colonne A(volet figer)

bonjour ma pomme
ton code fonctionne parfaitement sur le fichier
tri,message,reporting tout impeccable
par contre ça bloque sur mon fichier perso sur la ligne:

Sheets("Réception").Range("AG9:CR11").Columns(1).NumberFormat = "dd/mm/yyyy;@"


ca ne me fait pas le tri par date de la colonne A ,pas de message et pas de suppression de ligne si doubloe
alors que dans le fichier test ça marche ou se situe le problème

voici ma macro complète adapter a mon cas

Sub Reporting()
Application.ScreenUpdating = False
Sheets("Reporting complet").Select
ActiveSheet.Unprotect "david"
Sheets("Reporting palettes par jour").Select
ActiveSheet.Unprotect "david"
Dim n As Long
With Sheets("Reporting complet")
n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If n < 8 Then n = 8
Sheets("Réception").Range("AG9:CR11").Copy
.Cells(n, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(n, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
With Sheets("Reporting palettes par jour")
n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If n < 7 Then n = 7
Sheets("Réception").Range("CT8:CW10").Copy

.Cells(n, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(n, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
Sheets("Reporting complet").Select
ActiveSheet.Unprotect "david"
Sheets("Reporting palettes par jour").Select
ActiveSheet.Protect "david", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions
Sheets("Reporting complet").Select
ActiveSheet.Protect "david", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions
Call Macro2 "sauvegarde des documents dans son dossier archivage"
Call Macro1 "raz document effacement des celulles deverouillées"
Sheets("MENU").Select
MsgBox "La sauvegarde des documents a été réalisée avec succès.." + Chr$(13) + " Bravo Bonne Journée "
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub

julie vois tu le probleme
j'ai essyae de mettre le meme format de date en colone a croyant que c'etait ca mais ca n'arrange pas le probleme
au depart comme date j'avais
"jjj j mmmm aaaa"
et j'ai meme modifier pour ca
"jj/mm/aaaa"
sans résultat
merci de ton aide précieuse
Julie
 

julie999

XLDnaute Occasionnel
Re : selectionner la premiere cellule vide de la colonne A(volet figer)

re
en changeant le format de date la macro ne bloque plus mais elle ne fait pas le tri et ne supprime pas les ligne en double,de plus aucun message
??
Julie

ps :si ce n'est pas trop demander est ce possible de faire une petite macro pour supprimer les doublons sur la feuille reporting palette jour que je te joint en plus

s'il te plait

julie
 

Pièces jointes

  • julie test.xlsx
    122.5 KB · Affichages: 51
Dernière édition:

Discussions similaires

Réponses
2
Affichages
182

Statistiques des forums

Discussions
312 814
Messages
2 092 337
Membres
105 370
dernier inscrit
Leheryboriziny