Copie sur première plage vide
Bonjour à tous, même programme nouveau problème,
Voilà plusieurs jours que je cherche à résoudre un problème sur mon programme. Son but est d'afficher une liste de tableaux avec des numéros d'identification associés en prenant un 2ème fichier comme source (les deux fichiers se trouveront en pièce jointe). Plus précisément il n'affiche que les tableaux "incomplets" pour que le résultat serve de synthèse sur le travail restant à fournir. Voilà dans les grandes lignes ce que le programme fait.
Mon problème est qu'il faut que la copie des numéros d'identification (OF) et des tableaux associés (ce sont des listes de dates) doit se faire dans les premières cellules disponibles sur mon fichier de synthèse. Or jusque là la copie se fait au même niveau du fichier excel que sur le fichier d'origine. En clair, si le n° se trouve en ligne 28 sur le fichier d'origine, la copie se fera aussi en ligne 28 dans le fichier de synthèse.
Pour bien comprendre, le fichier où se trouvent les données sources est le fichier_BE et l'autre est le fichier_synthese.
Ci dessous le code :
Sub Bouton345_Cliquer()
'Cacher la recherche et les bascules entre fichiers durant le traitement
Application.ScreenUpdating = False
'déclarer les variables
Dim fichier_synthese As String
Dim fichier_origine_BE As String
'pour naviguer entre les fichiers OUVERTS sous windows
fichier_synthese = "Suivi_Modules_G_Synthese_V2.xlsm"
fichier_origine_BE = "Suivi_Modules_G_BE.xlsx"
'________________________________________________________________________
'________________________________________________________________________
'activer le fichier BE
Windows(fichier_origine_BE).Activate
'pour i allant de 5 à 200 avec un pas de 14 sur fichier BE
For i = 5 To 50 Step 14
Windows(fichier_origine_BE).Activate
'Si case OF pas vide dans fichier BE
If Cells(i, 2).Value <> "" Then
'---------------------------------------
'aller voir les n° d'OF pour voir si les cases sont occupées sous fichier synthese
For l = i - 1 To 50 Step 14
'revenir sous fichier synthese
Windows(fichier_synthese).Activate
'si la case est occupée emplacement saute 14 lignes (devient 18 après une boucle)
If (IsEmpty(Cells(l, 2))) Then
Windows(fichier_synthese).Activate
'super condition pour BE : scanner plage de données = si 1 vide entrer dans le traitement
Windows(fichier_origine_BE).Activate
For Each Cell In Range("B" & l + 8, "F" & l + 12)
Windows(fichier_origine_BE).Activate
'si case vide pendant le scan de la plage B12 : F16
If Cell = "" Then
'copie n° d'OF sous fichier BE
Windows(fichier_origine_BE).Activate
Cells(l + 1, 2).Copy
'revenir sous fichier synthese
Windows(fichier_synthese).Activate
'Coller le n° d'OF
Sheets("Suivi_Modules").Cells(l, 2).PasteSpecial xlPasteAll
'Ligne pour fichier BE
For j = l + 8 To l + 12
Windows(fichier_origine_BE).Activate
'colonne pour fichier BE
For k = 2 To 6
Windows(fichier_origine_BE).Activate
'////////////////////////////////////////////////////////
'teste toutes les cases une par une de B12 à F16
'si cellule vide, met NON sur synthese
If (IsEmpty(Cells(j, k))) Then
Windows(fichier_synthese).Activate
Cells(j, k + 1).Value = "NON"
'si cellule pleine
'si la cellule est pleine tu copies la date
ElseIf Not (IsEmpty(Cells(j, k))) Then
'revenir sur fichier BE
Windows(fichier_origine_BE).Activate
'copie la case
Cells(j, k).Copy
'retour sur fichier synthese
Windows(fichier_synthese).Activate
Sheets("Suivi_Modules").Cells(j, k + 1).PasteSpecial xlPasteAll
End If
'////////////////////////////////////////////////////////
Next k
Next j
End If
Next Cell
End If
Next l
End If
'---------------------------------------
Next i
'________________________________________________________________________
'________________________________________________________________________
End SubVous l'aurez remarqué il y a pas mal de boucles. La boucle i sert à tester les n° d'OF dans le fichier_BE. La boucle j et k à balayer l'ensemble de la plage de données (toutes les lignes et colonnes) pour faire le traitement. La boucle For Each Cell sert à tester avant d'entrer dans le programme si la plage de données contient une cellule vide. Auquel cas le programme entre dans le traitement. Et enfin la boucle l est censée résoudre mon problème.
Si vous faites un test sans toucher aux données des fichiers, en cliquant sur le bouton "Affaires non soldées" (sur le fichier synthèse, en ayant le fichier_BE ouvert), celui-ci va afficher plusieurs OF dont le premier est le n°20. Or il l'affiche en laissant un tableau vide. Dans mon idéal il aurait dû coller le n°20 en B5.
Comment faire pour qu'il le colle à la première plage de données (de destination) vide ???
Je suis bien entendu disposé à répondre à toutes vos questions si jamais quelque chose mérite éclaircissement !
Au plaisir de lire vos contributions,
Cordialement,
H.
Bonjour,
Une solution :
Sub Bouton345_Cliquer()
Dim FSynt$, FOrBE$, iRC%, iRS% '(iRS = RowSource,iRC = RowCible)
Dim WsS As Worksheet, WsC As Worksheet, o As Range, oo As Range, Flag As Boolean
Set WsS = Workbooks("Suivi_Modules_G_BE.xlsx").Worksheets("Suivi_BE")
Set WsC = Workbooks("Suivi_Modules_G_Synthese_V2.xlsm").Worksheets("Suivi_Modules")
Application.ScreenUpdating = False
'Initialisation de la cible
iRC = 4
With WsS
'pour i allant de 5 à 500 avec un pas de 14 sur fichier BE
For iRS = 5 To 500 Step 14
If .Cells(iRS, 2).Value <> "" Then
'super condition pour BE : scanner plage de données = si 1 vide entrer dans le traitement
For Each o In .Range(.Cells(iRS + 7, 2), .Cells(iRS + 11, 6))
'si case vide pendant le scan de la plage B12 : F16
If o = "" Then 'On copie tout
Flag = True
.Cells(iRS, 2).Copy
WsC.Cells(iRC, 2).PasteSpecial xlPasteAll
.Range(.Cells(iRS + 7, 2), .Cells(iRS + 11, 6)).Copy
WsC.Range(WsC.Cells(iRC + 8, 3), WsC.Cells(iRC + 12, 7)).PasteSpecial xlPasteAll
For Each oo In WsC.Range(WsC.Cells(iRC + 8, 3), WsC.Cells(iRC + 12, 7))
If oo = "" Then oo = "NON" 'on remplace les vide par NON
Next
Exit For
End If
Next o
If Flag Then iRC = iRC + 14 'on incrémente la ligne cible
Flag = False
End If
Next iRS
End With
Application.CutCopyMode = False
End SubPS : Attention à bien mettre à jour le nom des classeurs !
A+
Bonjour galopin,
Tout d'abord je tiens à te remercier grandement, ca fonctionne au top ! Bon le seul bémol pour le moment c'est que je ne comprends pas tout le code, mais ca va venir (je vais le décortiquer
Simple question : tu t'es servi de la boucle For Each pour remplacer les deux boucles j et k c'est bien ca ?
En tout cas merci beaucoup tu m'enlèves une grande épine du pied !
Cordialement,
H.
Bonjour,
Heu... je n'ai pas vraiment cherché à modifier l'existant qui me semblait un peu brouillon !
Nota :
Dans le commentaire du code il faut lire "iRC = RowCible"
voir le code modifié plus haut. (J'ai rajouté également la variable Flag que j'avais oublié de déclarer)
En gros mon code c'est
On détermine la ligne cible dans le classeur cible
iRC = 4
S'il y a un N° OF dans le classeur Source on regarde s'il y a un vide dans le paquet de dates
Si oui on fait le traitement :
Copie du N° OF
Copie du paquet
Remplacement des vides
et on sort du "For Each o ..." avec "Exit For" pour passer au N° OF suivant en incrémentant iRC +14
La petite astuce c'est le Flag (c'est un Booléen) qui permet de savoir si on a trouvé un vide dans le paquet. (Donc si on peut passer au N° OF suivant...)
A+
C'est sûr que l'existant était un peu brouillon, je te l'accorde !
Merci pour tes précisions ca me semble plus clair maintenant !
Bonne journée,
H.