Discussion :

[Monsieur Peck]

Bonjour à tous,

Dans un dossier, je dispose de trois classeur intitulés "Synthèse", "1" et "2" ayant la même structure et constitués chacun de 3 feuilles nommées "Lundi", "Mardi" et "Mercredi".

Je souhaiterai savoir s'il est possible en cliquant sur un bouton dans le fichier "Synthèse" que les lignes des fichiers "1" et "2" dont au moins une cellue ne soit pas vide dans la plage de colonne H à S se rapatrient dans ce fichier. Si les celulles sont vides, la ligne en question n'est pas rapatriée et on passe à la ligne suivante.

En vous remerciant pour votre aide.

[mayekeul]

bonjour,

c'est possible

un peu dans ce genre là

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub synthese()
Dim WBS(1 To 2) As Workbook
Dim C As Range
Dim I As Integer, R As Integer, WB As Integer, DestRow As Integer
Dim strRange As String, F As Variant, Test As String
Dim NoMoreTeam As Boolean
 
 
'referencer les classeurs
Set WBS(1) = GetObject(ActiveWorkbook.Path & "\1.xls")
Set WBS(2) = GetObject(ActiveWorkbook.Path & "\2.xls")
 
'parcourir les fuilles
Application.ScreenUpdating = False
For WB = 1 To 2
    For Each F In Array("LUNDI", "MARDI", "MERCREDI")
        NoMoreTeam = False
        R = 7
        Do Until NoMoreTeam
            strRange = Replace("H%:S%", "%", CStr(R))
            For Each C In WBS(WB).Sheets(F).Range(strRange)
                Test = Test & C.Value
            Next C
            If Not Test = "" Then
                WBS(WB).Sheets(F).Rows(R).Copy
                ActiveWorkbook.Sheets(F).Range("B65536").End(xlUp).Offset(1, -1).PasteSpecial
            End If
            R = R + 1
            If WBS(WB).Sheets(F).Cells(R, 2) = "" Then NoMoreTeam = True
        Loop
    Next F
    Set WBS(WB) = Nothing
Next WB
Application.ScreenUpdating = True
 
End Sub

[Monsieur Peck]

Bonjour,

Merci pour votre participation. J'aurai une question concernant les lignes suivantes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 For Each C In WBS(WB).Sheets(F).Range(strRange)
                Test = Test & C.Value
            Next C
            If Not Test = "" Then
                WBS(WB).Sheets(F).Rows(R).Copy
                ActiveWorkbook.Sheets(F).Range("B65536").End(xlUp).Offset(1, -1).PasteSpecial
            End If

Je suppose que c'est ce qui permet de vérifier la présence de cellule vide dans la plage H à S, néanmoins même si cette plage est vide, la ligne en question est rapatriée. Ceci est-il dû au fait que les cellulse B, C, D, E, et F de cette ligne ne sont pas vides?

[mayekeul]

on peux faire autrement

on redéfinit test

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

dim TEST as boolean

ensuite on change dans la boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Do Until NoMoreTeam
            strRange = Replace("H%:S%", "%", CStr(R))
            For Each C In WBS(WB).Sheets(F).Range(strRange)
                if ucase(c)="X" then test=true
            Next C
            If test Then
                WBS(WB).Sheets(F).Rows(R).Copy
                ActiveWorkbook.Sheets(F).Range("B65536").End(xlUp).Offset(1, -1).PasteSpecial
            End If
            R = R + 1
            If WBS(WB).Sheets(F).Cells(R, 2) = "" Then NoMoreTeam = True
            test=false
        Loop

[Monsieur Peck]

Merci beaucoup Mayekeu.