macro copie spéciale cellule vide ou égale à zéro

briatexte

XLDnaute Nouveau
Bonjour,

J'ai rencontré un problème concernant la copie spéciale via une macro vers une autre feuille que j'ai résolu. Voyant que mes recherches ne m'ont pas été utiles, je me permets de vous proposer ma solution (j'en ai mal à la tête....).

Pour vous expliquer: Mon tableau de base comprend 5 colonnes et 5 lignes qui sont remplies par l'intermédiaire de différentes formules récupérant les données sur différents tableaux. Les 5 lignes ne sont pas forcément toujours utilisées chaque jour, j'en ai parfois une, 2, 3 qui sont remplies les suivantes restant vides (mais contenant les formules).

Ces données sont expédiés chaque soir par une macro vers un tableau recap et mon souhait était que l'inscription se fasse à la suite de la dernière ligne utilisée.
Mon problème débutait à ce niveau.
Le collage spécial me recopiait systématiquement les cinq lignes sur le tableau recap créant ainsi des lignes vides dans la récap. Je suis parvenu à contourner le problème de la manière suivante:

Sub archives()

Dim DerLigne As Long
Dim A4 As String
Dim A5 As String
Dim classeurSource As Workbook, classeurDestination As Workbook


'Non prise en charge des cellules vides mais étant non vide parce qu'elles contiennent une formule.
'remplacement, dans le tableau initial de la cellule vide par un zéro avec si(xxx="";;xxxx) puis recherche dans la colonne A des cellules égale à zéro pour suppression de la ligne


'définir le classeur source
Set classeurSource = ThisWorkbook

'tableau caché

A4 = "Tableau de suivi"

'tableau créé pour la copie spéciale
A5 = "test"

'selection du classeur source de la feuille et des cellules puis "copier"
classeurSource.Sheets(A4).Select
Range("a9:e13").Select
Application.CutCopyMode = False
Selection.Copy

'selection du classeur destination, de la feuille, et de la cellule à "coller" puis collage spécial
classeurSource.Sheets(A5).Select
Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.ScreenUpdating = False

'Choix de la colonne A36 comme départ (dans feuille destination) puis recherche des "0" en remontant
For i = Range("A36").End(xlUp).Row To 1 Step -1

'si une cellule dans la colonne A contient un "0", suppression de la ligne

If Cells(i, 1) = 0 Then Rows(i).Delete
Next i
Application.ScreenUpdating = True




'ouvrir le classeur destination et copie des données à la suite des données du jour précédent

Set classeurDestination = Application.Workbooks.Open(ThisWorkbook.Path & "/" & "suivi.xls", , False)

'copier les données du classeur source vers le classeur destination "recap"
classeurSource.Sheets(A5).Range("A1:E5").Cells.Copy
classeurDestination.Sheets("Feuil1").Select
DerLigne = Range("A65536").End(xlUp).Row
Range("A" & DerLigne + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub


Voyant que beaucoup de participants sur les forums rencontrent ce problème, j'ai, modestement, mis ma solution. Vous ne la trouverez certainement pas parfaite, voire "merdique" alors je suis preneur pour toute amélioration.
Je tiens à préciser qu'elle marche parfaitement chez moi, et que je suis débutant.....
 

Discussions similaires

Réponses
7
Affichages
315

Statistiques des forums

Discussions
312 147
Messages
2 085 767
Membres
102 968
dernier inscrit
Tmarti