Discussion :

[LaventureEstivene]

Salutation,

J'ai un problème, je n'arrive pas accéder à un repéré les cases fusionné malgré mon code

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
 
Sub remplissage_test()
'Auteur Docmarti 24/08/2014
 
Dim Rise As Double, debut As Double, fin As Double
Dim nb As Long, i As Double, j As Long, Fin1 As Long
Dim o As String
 
 
 'Executing with Book1.xlsm active and Book2.xlsx open.
Dim wb As Workbook
Dim Wf As WorksheetFunction
Set Wf = WorksheetFunction
 
Sheets("test").Select
o = Sheets("test").Name
 
 
 
j = 1 'debut en longueur colonne
Fin1 = 1      'longueur
 
debut = 2 ' debut en profondeur ligne
finp = 20     'profondeur
 
 
Sheets("test").Cells(1, 1).Select
 
 
Do While j <= Fin1
 
 
    For i = debut To finp
 
       Cells(i, j).Select
      If ActiveCell.MergeCells = True Then 'Wf.IsText(Cells(i, j).Value) Then
      'If Cells(i, j).Borders(xlEdgeRight).LineStyle = xlContinuous Then 'Cells(i, j) = "" Then 'WorksheetFunction.IsText(Cells(i, j).Value) Then
 
        Cells(i, j + 1) = i
      End If
 
    Next
j = j + 1
Loop
j = j - 1
Cells(i, j).Select
MsgBox i
MsgBox j
End Sub

J'ai de plus de nombreux problème avec l'erreur 1004 qui apparait à répétition et qui m'empêché d'utiliser les propriétés activate ou select.

[Invité]

Bonjour,

Pièce jointe 598976


A tester :

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
 
Option Explicit
 
Sub Remplissage_Test2()
 
Dim ShTest As Worksheet
Dim AireATester As Range
Dim I As Long, LigneDebut As Long, LigneFin As Long
 
  Set ShTest = Sheets("test")
  With ShTest
       LigneDebut = 1
       LigneFin = .Cells(.Rows.Count, 1).End(xlUp).Row
       Set AireATester = .Range(.Cells(LigneDebut, 1), .Cells(LigneFin, 1))
       For I = 1 To AireATester.Count
           With AireATester(I)
                If .MergeCells = True Then .Offset(0, 1) = I
           End With
       Next I
  End With
 
  Set ShTest = Nothing
  Set AireATester = Nothing
 
End Sub

[LaventureEstivene]

Alors merci, tu as fais un code super mais je me demandais pourquoi ton .MergeCells fonctionne pour toi et pas moi ?