test sur une feuille

[Phil76]

Bonjour à tous.

J'ai une feuille dans laquelle je vais stocker des informations en fonction d'un critére précis.
Si cette feuille contient des informations, le programme traite sans problème.
Si cette feuille ne contient aucune information, comment puis-je faire pour terminer la procedure en cours et faire appel à une autre.
'Synthése des données

Application.ScreenUpdating = False
Sheets("Extraction").Range("A1:F65000").ClearContents
With Sheets("Données")
derligne = .Range("B" & Rows.Count).End(xlUp).Row
For Each c In .Range("A1:A" & derligne - 1).SpecialCells(xlCellTypeBlanks)
If c.Offset(0, 2) >= 30 Then
c.Offset(-1, 1).Resize(1, 6).Copy
Sheets("Extraction").Range("B65000").End(xlUp).Offset(1, -1).PasteSpecial Paste:=xlPasteValues

Else
Exit Sub

End If
Next c
End With
With Sheets("Données")
derligne = .Range("B" & Rows.Count).End(xlUp).Row
For Each c In .Range("A1:A" & derligne - 1).SpecialCells(xlCellTypeBlanks)
If c.Offset(0, 2) >= 30 Then
c.Offset(0, 2).Resize(1, 1).Copy
Sheets("Extraction").Range("G65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues

End If
Next c
End With
'Préparation pour la copie des données vers la feuille du mois en cours

Application.DisplayAlerts = False
Sheets("Extraction").Select
Columns("B:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Selection.SpecialCells(xlCellTypeLastCell).Select
Selection.Offset(0, -6).Formula = "=SUM(E:E)"
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Copy


La ligne qui pose problème est celle-ci :
Selection.Offset(0, -6).Formula = "=SUM(E:E)"

 

[camarchepas]

Re : test sur une feuille

Bonjour,

Sans avoir le fichier sous les yeux difficile de voir.

Dommage le code pourrait être optimisé et validé.

Enfin , j'ai corrigé comme ceci avec un échantillon de données à ma sauce .

Option Explicit

Sub Test()
Dim Derligne As Long
Dim C As Range
Application.ScreenUpdating = False
 Sheets("Extraction").Range("A1:F" & Rows.Count).ClearContents
 With Sheets("Données")
  Derligne = .Range("B" & Rows.Count).End(xlUp).Row
  If Derligne > 1 Then
   For Each C In .Range("A1:A" & Derligne - 1).SpecialCells(xlCellTypeBlanks)
   
    If C.Offset(0, 2) >= 30 Then
      C.Offset(-1, 1).Resize(1, 6).Copy
      Sheets("Extraction").Range("B" & Rows.Count).End(xlUp).Offset(1, -1).PasteSpecial Paste:=xlPasteValues
     Else
      Exit Sub

    End If
   Next C
  End If

  Derligne = .Range("B" & Rows.Count).End(xlUp).Row
  If Derligne > 1 Then
   For Each C In .Range("A1:A" & Derligne - 1).SpecialCells(xlCellTypeBlanks)
   
    If C.Offset(0, 2) >= 30 Then
     C.Offset(0, 2).Resize(1, 1).Copy
     Sheets("Extraction").Range("G" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    End If
   Next C
  End If
 End With

'Préparation pour la copie des données vers la feuille du mois en cours
 Application.DisplayAlerts = False
  Sheets("Extraction").Select
  Columns("B:C").Select
  Application.CutCopyMode = False
  Selection.Delete Shift:=xlToLeft
  Derligne = Range("A" & Rows.Count).End(xlUp).Row
  If Derligne > 1 Then
   Selection.SpecialCells(xlCellTypeLastCell).Select
   Selection.Offset(0, -6).Formula = "=SUM(E:E)"
   Range("A1").CurrentRegion.Select
   Selection.Copy
  End If
 End Sub

 

[Phil76]

Re : test sur une feuille

Merci camarchepas.
C'est pas tout à fait ce que je voulais, mais je garde au cas ou.
Je peux malheuresement pas envoyer mon fichier entier. Trop gros.
Sinon, comment je peux tester si une feuille est vierge, et comment en fonction du resultat, je peux stopper une procedure pour aller vers une autre.
Merci encore pour ton aide.

 

[Efgé]

Re : test sur une feuille

Bonjour Phil76, Bonjour camarchepas 🙂
Nous nous confrontons à un problème bien connu, Le Fichier Top Secret
Il est bien évident que le forum est scruté par bon nombre d'agents de la sécurité intérieure de différents pays.

Le Problème est le suivant:
Si je mets un fichier exemple avec comme noms de colonnes Date, nom, prénom, les agents "de pays étranger" vont bien évidemment, comprendre que date doit correspondre à Nom, que Nom doit correspondre à adresse et que Prénom doit correspondre à somme versée...
Comme nous nous confrontons à des professionnels il leur sera façile de découvrir que sous le nom de " test sur une feuille" il s'agit, en réalité, de transposer chaque feuille en micro fiche, qui elle-même transiteront par l'ambassade Bordure(elle même infilrée par des agents syldave, mais ceci est un autre sujet...)

Je gage que nous devrions rapidement trouver un fil intitulé "Comment copier le plus rapidement possible des microfiches"

Enfin bref tout ceci est tellement complexe que l'on peut comprendre la réticence de bon nombre à laisser un fichier que l'on sait désormais non anonyme....
Cordialement

 

[Phil76]

Re : test sur une feuille

Non non Efgé mon fichier complet fait 21 Mo.
J'ai juste envi de trouver une solution à mon problème.😕

 

[Efgé]

Re : test sur une feuille

Bonjour Phil76, camarchepas, le fil, le forum, Un code qui récupère dans un tableau les noms des feuilles vides (vraiment vides).Cordialement