Problème SkipBlanks

F

foxbox545

XLDnaute Nouveau
Bonjour à tous et merci de votre aide,

Je vous expose mon problème:

Je travail sur un fichier regroupant des informations classées par mois sur différents onglets. Dans un dernier onglet, nommé DB, je souhaite que l'ensemble des informations présentes dans les autres onglets soient restituées. Pour cela, je m'aide de la formule Skipblanks pour pouvoir selectionner des plages de données larges, pour que je n'ai pas à les redéfinir à chaque fois que j'ajoute des informations dans un onglet "mois". Problème, la macro skipblanks me joue des tours entre le mois de novembre et le mois de décembre. Voici ma macro:

Sub Base_données()
'
' Base_données Macro
' Macro enregistrée le 10/10/2008 par JFM
'
' Touche de raccourci du clavier: Ctrl+Maj+M
'
Sheets("Jan").Select
Range("B12:S59").Select
Selection.Copy
Sheets("DB").Select
Range("A8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Fév").Select
Range("B13:S59").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DB").Select
ActiveWindow.SmallScroll Down:=27
Range("A56").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=51
Sheets("Mar").Select
Range("B13:S60").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DB").Select
Range("A103").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=48
Range("A151").Select
Sheets("Avr").Select
Range("B13:S59").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DB").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Mai").Select
Range("B13:S60").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DB").Select
ActiveWindow.SmallScroll Down:=51
Range("A198").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=42
Sheets("Jun").Select
Range("B13:S59").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DB").Select
Range("A246").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=39
Sheets("Jul").Select
Range("B13:S58").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DB").Select
Range("A293").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=45
Sheets("Aou").Select
Range("B13:S58").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DB").Select
Range("A339").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Sep").Select
Range("B13:S59").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DB").Select
ActiveWindow.SmallScroll Down:=45
Range("A385").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=30
Sheets("Oct").Select
Range("B13:S58").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DB").Select
ActiveWindow.SmallScroll Down:=18
Range("A432").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=51
Sheets("Nov").Select
Range("B13:S58").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DB").Select
Range("A478").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Nov").Select
Selection.Copy
Sheets("DB").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Déc").Select
Range("B13:S59").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DB").Select
ActiveWindow.SmallScroll Down:=48
Range("A524").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Application.ScreenUpdating = False
Dim l As Integer
For l = Cells(65256, 8).End(xlUp).Row To 8 Step -1
If Cells(l, 1).Value = "" Then Cells(l, 1).EntireRow.Delete
Next l

End Sub


Merci d'avance pour votre aide.
 
Trier par date Trier par votes
Gorfael

Gorfael

XLDnaute Barbatruc
Re : Problème SkipBlanks

Salut foxbox545 et le forum
Code: 
Pour cela, je m'aide de la formule Skipblanks
Je ne comprends pas ce que tu veux dire : Skipblanks est systématiquement à faux dans toutes tes formules => pas actif!!!
Code: 
Dim X As Long
Application.ScreenUpdating = False
Sheets("Jan").Range("B12:S59").Copy
Sheets("DB").Range("A8").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A8").PasteSpecial Paste:=xlPasteFormats
Sheets("Fév").Range("B13:S59").Copy
Sheets("DB").Range("A56").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A56").PasteSpecial Paste:=xlPasteFormats
Sheets("Mar").Range("B13:S60").Copy
Sheets("DB").Range("A103").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A103").PasteSpecial Paste:=xlPasteFormats
Sheets("Avr").Range("B13:S59").Copy
Sheets("DB").Range("A151").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A151").PasteSpecial Paste:=xlPasteFormats
Sheets("Mai").Range("B13:S60").Copy
Sheets("DB").Range("A198").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A198").PasteSpecial Paste:=xlPasteFormats
Sheets("Jun").Range("B13:S59").Copy
Sheets("DB").Range("A246").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A246").PasteSpecial Paste:=xlPasteFormats
Sheets("Jul").Range("B13:S58").Copy
Sheets("DB").Range("A293").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A293").PasteSpecial Paste:=xlPasteFormats
Sheets("Aou").Range("B13:S58").Copy
Sheets("DB").Range("A339").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A339").PasteSpecial Paste:=xlPasteFormats
Sheets("Sep").Range("B13:S59").Copy
Sheets("DB").Range("A385").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A385").PasteSpecial Paste:=xlPasteFormats
Sheets("Oct").Range("B13:S58").Copy
Sheets("DB").Range("A432").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A432").PasteSpecial Paste:=xlPasteFormats
Sheets("Nov").Range("B13:S58").Copy
Sheets("DB").Range("A478").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A478").PasteSpecial Paste:=xlPasteFormats
Sheets("Déc").Range("B13:S59").Copy
Sheets("DB").Range("A524").PasteSpecial Paste:=xlPasteValues
Sheets("DB").Range("A524").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
For X = Cells(65256, "H").End(xlUp).Row To 8 Step -1
If Cells(X, "A") = "" Then Rows (X)
Next X
End Sub
Ton code "remanié" : effectivement, ton code était bizarre pour l'onglet Nov. Et la syntaxe que tu utilises rend ton code illisible. Le but d'épurer un code n'est pas de diminuer le nombre de lignes, ce n'est qu'un corollaire, le but est de rendre compréhensible et lisible facilement de sorte que les différences (surtout dans un cas répétitif, comme ici) ressortent mieux.
En admettant que la feuille Jan soit la première et Déc la 12ème, on pourrait simplifier avec une macro du style
Code: 
Sub Base_données()
Dim X As Long, F As Integer
Application.ScreenUpdating = False
For F = 1 To 12
    Sheets(1).Range("B12:S59").Copy
    
    Sheets(F).Range("A" & (8 + (48 * F))).PasteSpecial Paste:=xlPasteValues
    Sheets(F).Range("A" & (8 + (48 * F))).PasteSpecial Paste:=xlPasteFormats
Next F
Application.CutCopyMode = False
For X = Cells(65256, "H").End(xlUp).Row To 8 Step -1
If Cells(X, "A") = "" Then Rows (X)
Next X
End Sub
Ça me semble plus lisible, mais comme je n'ai essayé aucune des macros, je me suis juste inspiré du code.

Remarques :
- Je déclare toujours une variable dans le format qui ne me renverra pas d'erreur : Integer n'allant que jusqu'à 32767 et les lignes pouvant atteindre 65536 (éh oui, un espace en ligne 65536 peut arriver), mes variables lignes sont toujours déclarées en Long : Le gain de 2 octets ne justifie pas de risquer une erreur.
-On peut agrémenter ma macro d'un Select Case Sheets(F).Name, en mettant, ces adresses de copies dans chaque "Case", mais ça ne me semble pas se justifier.
- L'instruction Application.CutCopyMode = False ne sert qu'à enlever les tirets clignotants suite à une copy : une seule fois suffit, et même, comme on fait des actions après, l'omettre ne change rien.
- L'instruction Skipblanks:=True risque d'avoir des répecutions inattendues : tu aurais des décalages à chaque case vide. Pas glop, pas glop!
-Pense à utiliser les balises de code (icone #)
A+
 
Vote positif 0 Vote négatif
Dull

Dull

XLDnaute Barbatruc
Re : Problème SkipBlanks

Salut foxbox545, Gorfael:), le Forum

n'apporterienàladiscution... Juste pour faire un coucou a l'ami dragon :) lui dire qu'il se fait rare sur ce forum et qu'il nous manque beaucoup.

Bonne Journée
 
Vote positif 0 Vote négatif
F

foxbox545

XLDnaute Nouveau
Re : Problème SkipBlanks

J'ai essayé d'intégrer tes code sur le fichier mais, étant très mauvais en macro, je n'y arrive pas car un certain nombre de chose m'échappe.
Que signifie les inconnues entre parenthèse (X, "A") et (X):
If Cells(X, "A") = "" Then Rows (X)
Et par quoi dois je les remplacer si je veux que le code fonctionne ? Merci
 
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
309
robpellan52
R
F
  • Résolu(e)
Microsoft 365 Message Box oui/non
Réponses
2
Affichages
158
Francky79
F
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
401
gwenn49
G
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
490
olivier388
O
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
Usine à gaz
  • Résolu(e)
XL 2021 Coller "RdV Fait Facturé" de "J" ligne active jusqu'à "J" dernière ligne NON vide
2
Réponses
27
Affichages
691
TooFatBoy
TooFatBoy
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
410
fanou06
F
M
  • Question
Microsoft 365 Erreur de format
Réponses
5
Affichages
178
Marvin57
M
Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
347
Usine à gaz
Usine à gaz
A
  • Résolu(e)
XL 2013 Code VBA incompatible avec version Excel
Réponses
2
Affichages
425
Averell1976
A

Membres actuellement en ligne

14 membres et 114 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 520
Messages
2 089 286
Membres
104 084
dernier inscrit
dadap