XL pour MAC VBA - Feuilles qui se complètent

[ArnaudSi]

Bonjour à tous

C'est un classeur Excel avec deux feuilles
- Saisie
- Facture

On saisie des lignes sur la feuille "Saisie" qui sont transférées sur la feuille "Facture"

Les lignes de saisie s'accumulent une en dessous de l'autre
Et la feuille facture est composé de trois pages
Chaque page est composé d'une entête et d'un pied de page

L'objectif est donc que les saisie soient transférés sans pour autant empiéter l'entête et le pied de page

Sub Transfert_Facture()

Dim Cell As Range
Dim Ligne, Reponse As Integer

Reponse = MsgBox("Confirmez-vous le Tranfert Façonnage, Coupe, sur la feuille Facture?", vbYesNo)

If Reponse = vbYes Then

    With Sheets("Facture")
   
                Select Case Ligne
                    Case Range("B28").Value = " "
                        Ligne = .Cells(29, 2).End(xlUp).Row + 1
                    Case Range("B62").Value = " "
                        Ligne = .Cells(63, 2).End(xlUp).Row + 1
                    Case Range("B96").Value = " "
                        Ligne = .Cells(97, 2).End(xlUp).Row + 1
                    Case Else
                        MsgBox "Transfert impossible: tableau complet."
                    Exit Sub 'permet d'arrêter le transfert
                End Select
                
                    Application.ScreenUpdating = False
                
                                    Cells(Ligne, 2) = Range("B3").Value
                                   
                                    Cells(Ligne, 3) = Range("C3").Value
                                   
                                    Cells(Ligne, 4) = Range("D3").Value
                                       
                                    Cells(Ligne, 5) = Range("E3").Value
               
                    Application.ScreenUpdating = True
                     
    End With
             
    MsgBox "Transfert Façonnage réussi!"
           
    Else
    MsgBox "Transfert interrompu."
    End If

End Sub

Malheureusement, ça ne fonctionne pas et je ne trouve pas l'erreur...
Le transfert des données s'effectue sur la même feuille ("Saisie").

Merci.

 

[job75]

Bonjour ArnaudSi,

Il faut des points devant tous les Range et Cells qui sont dans la feuille "Facture"...

A+

 

[ArnaudSi]

Bonjour job57

Merci pour votre réponse

Ça fonctionne !

Les données sont bien transférées vers la "page 1" mais une fois la "page 1" complète, elles ne se répercute pas vers la "page 2" et la "page 3" ensuite.

Le souci vient de la partie "Select Case". Je ne sais pas vraiment pourquoi...
Peut être y a t il une autre formule pour résoudre ce genre de problème?

Merci.

Sub Transfert_Facture()

Dim Cell As Range
Dim Ligne, Reponse As Integer

Reponse = MsgBox("Confirmez-vous le Tranfert Façonnage, Coupe, sur la feuille Facture?", vbYesNo)

If Reponse = vbYes Then

    With Sheets("Facture")
  
                Select Case Ligne
                    Case Range("B28").Value = " "
                        Ligne = .Cells(29, 2).End(xlUp).Row + 1
                    Case Range("B62").Value = " "
                        Ligne = .Cells(63, 2).End(xlUp).Row + 1
                    Case Range("B96").Value = " "
                        Ligne = .Cells(97, 2).End(xlUp).Row + 1
                    Case Else
                        MsgBox "Transfert impossible: tableau complet."
                    Exit Sub 'permet d'arrêter le transfert
                End Select
                
                    Application.ScreenUpdating = False
                
                                    .Cells(Ligne, 2) = Range("B3").Value
                                  
                                    .Cells(Ligne, 3) = Range("C3").Value
                                  
                                    .Cells(Ligne, 4) = Range("D3").Value
                                      
                                    .Cells(Ligne, 5) = Range("E3").Value
              
                    Application.ScreenUpdating = True
                    
    End With
            
    MsgBox "Transfert Façonnage réussi!"
          
    Else
    MsgBox "Transfert interrompu."
    End If

End Sub

 

[job75]

Bonjour ArnaudSi,

Votre code était inutilement compliqué, utilisez cette macro :

Sub Transfert_Facture()
If [B3] = "" Then Exit Sub
Dim c As Range
Set c = Sheets("Facture").[B7:B28,B42:B62,B76:B96].Find("", , xlValues)
If c Is Nothing Then MsgBox "Désolé, plus de place...": Exit Sub
c.Resize(, 4) = [B3:E3].Value
End Sub

A+

 

[ArnaudSi]

Quelle magnifique macro, quelle élégance! C'est de l'art...
Merci beaucoup job75 ! 🙂

 

[ArnaudSi]

Et si maintenant on a des données qui ne s'accumulent pas forcément les unes en dessous des autres, comment faire pour que les données de prix soient toujours transférés sur la même ligne que celle de la désignation.

Sub Transfert_Facture()
If [B3] = "" Then Exit Sub

Dim c As Range
Set c = Sheets("Facture").[B7:B28,B42:B62,B76:B96].Find("", , xlValues)
If c Is Nothing Then MsgBox "Désolé, plus de place...": Exit Sub
c.Resize(, 4) = [B3:E3].Value

Dim d As Range
Set d = Sheets("Facture").[B7:B28,B42:B62,B76:B96].Find("", , xlValues)
If d Is Nothing Then MsgBox "Désolé, plus de place...": Exit Sub
d.Resize(, 1) = [B6].Value

Dim e As Range
Set e = Sheets("Facture").[E7:E28,E42:E62,E76:E96].Find("", , xlValues)
If e Is Nothing Then MsgBox "Désolé, plus de place...": Exit Sub
e.Resize(, 1) = [C6].Value

Dim f As Range
Set f = Sheets("Facture").[B7:B28,B42:B62,B76:B96].Find("", , xlValues)
If f Is Nothing Then MsgBox "Désolé, plus de place...": Exit Sub
f.Resize(, 1) = [B9].Value

End Sub

En effet, avec ce code, si dans la colonne "Désignation" il y a à une ligne un commentaire (sans prix) et que l'on transfert un nouveau produit, le prix de celui ci viendra automatiquement dans la case vide la plus haute.

Merci.