Discussion :

[delakoff]

bonjour a tous! j'aurais vraiment besoin de votre aide
en effet jai un classeur avec deux feuilles! la première feuille a des cellules avec des commentaires
j'aimerais par une boucle sur la première feuille remplir avec la seconde feuille.
seulement pour les texts simple ca marche mais pour les commentaires non!

Voici le code que je fais

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Public Sub TousPaiements()
Dim WB1 As Workbook, FL1 As Worksheet, FL2 As Worksheet, FL3 As Worksheet, FL4 As Worksheet, FL5 As Worksheet, FL6 As Worksheet, FL7 As Worksheet, FL8 As Worksheet
Dim DerLigne As Long, Cmmt As Comment
Dim I As Integer, J As Integer, Cmpt As Long, DerCellNonVide As String, Add As Integer, Garber As Variant, Cmt As Comment
Dim Strad As String, Stradd As String, SomTotal As Long, MyTbl As Variant, K As Integer, L As Integer, Derlig As Long
Set WB1 = Workbooks("Cls_Loyer")
Set FL1 = WB1.Worksheets("Bdd_Loyer")
Set FL8 = WB1.Worksheets("Paiements")
 
DerCellNonVide = Mid(FL1.Cells(2, Columns.Count).End(xlToLeft).Address, 2, 2) ' On recupere l'adresse de la derniere colonne
Add = Range(DerCellNonVide & ":" & DerCellNonVide).Column 'Numéro de la derniere colonne
 
FL8.Rows("2:65536").EntireRow.Delete
 
DerLigne = 2
Cmpt = 0
Som = 0
For I = 3 To 315
       For J = 9 To Add Step 4
              Select Case FL1.Cells(I, J + 3).Value
                     Case "OUI"
                     FL8.Cells(DerLigne, 1) = FL1.Cells(I, J + 1)
                     FL8.Cells(DerLigne, 2) = FL1.Cells(I, 1)
                     FL8.Cells(DerLigne, 3) = FL1.Cells(I, 3)
                     FL8.Cells(DerLigne, 4) = UCase(MonthName(Month(FL1.Cells(I, J))) & Year(FL1.Cells(I, J)))
                     FL8.Cells(DerLigne, 5) = FL1.Cells(I, 5)
                     FL8.Cells(DerLigne, 6) = FL1.Cells(I, J + 2)
                     Strad = FL1.Cells(I, J).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                     Range(Strad).Activate
                     If Not ActiveCell.Comment Is Nothing Then
                            FL8.Cells(DerLigne, 7) = ActiveCell.Comment.Text
                     Else
                            FL8.Cells(DerLigne, 7) = "ESPECE"
                     End If
                     Stradd = FL1.Cells(I, J + 3).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                     Range(Stradd).Activate
                     If Not ActiveCell.Comment Is Nothing Then
                            FL8.Cells(DerLigne, 8) = ActiveCell.Comment.Text
                     Else
                            FL8.Cells(DerLigne, 8) = "VALIDE"
                     End If
                     FL8.Cells(DerLigne, 9) = I
                     FL8.Cells(DerLigne, 10) = J
                     DerLigne = DerLigne + 1
                     Cmpt = Cmpt + 1
                     Som = Som + FL1.Cells(I, 5)
              End Select
       Next
Next
FL8.Cells(2, 11) = Cmpt
FL8.Cells(2, 12) = Som
 
End Sub

merci pour votre aide

[unparia]

Bonjour
- Veux-tu bien mettre ton code entre balises code, s'il te plait ? Il est en l'état pénible à lire
- on ne travaille pas à coups de select, activate etc ..., mais directement sur les objets Excel
- intéresse-toi vite à ce que tu liras dans la rubrique Range.SpecialCells, méthode de ton aide interne VBA. Elle te permettra de déterminer la plage (un objet range) des cellules dotées d'un commentaire. Travaille ensuite avec cet objet Range.