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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
| Option Explicit
Sub chalou33()
Dim oRng As Range
Dim oCell As Range
'Application.Visible = False
'Application.Calculation = xlCalculationManual
With Worksheets("Feuil1")
Set oRng = Union(FindAll("R", .Columns(14), xlFormulas, xlWhole), FindAll("C", .Columns(14), xlFormulas, xlWhole), FindAll("F", .Columns(14), xlFormulas, xlWhole))
For Each oCell In oRng
oCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown
oCell.Offset(1, -8) = oCell.Offset(0, -5)
oCell.Offset(1, -7) = oCell.Offset(0, -4)
oCell.Offset(1, -9) = oCell.Offset(0, -3)
Next oCell
End With
'Application.Calculation = xlCalculationAutomatic
'Application.Visible = True
End Sub
Function FindAll(What, Optional SearchWhat As Variant, _
Optional LookIn, _
Optional LookAt, _
Optional SearchOrder, _
Optional SearchDirection As XlSearchDirection = xlNext, _
Optional MatchCase As Boolean = False, _
Optional MatchByte, _
Optional SearchFormat) As Range
'LookIn can be xlValues or xlFormulas, _
LookAt can be xlWhole or xlPart, _
SearchOrder can be xlByRows or xlByColumns, _
SearchDirection can be xlNext, xlPrevious, _
MatchCase, MatchByte, and SearchFormat can be True or False. _
Before using SearchFormat = True, specify the appropriate settings _
for the Application.FindFormat object, e.g., _
Application.FindFormat.NumberFormat = "General;-General;""-"""
Dim aRng As Range
If IsMissing(SearchWhat) Then
On Error Resume Next
Set aRng = ActiveSheet.UsedRange
On Error GoTo 0
ElseIf TypeOf SearchWhat Is Range Then
If SearchWhat.Cells.Count = 1 Then
Set aRng = SearchWhat.Parent.UsedRange
Else
Set aRng = SearchWhat
End If
ElseIf TypeOf SearchWhat Is Worksheet Then
Set aRng = SearchWhat.UsedRange
Else
Exit Function '*****
End If
If aRng Is Nothing Then Exit Function '*****
Dim FirstCell As Range, CurrCell As Range
With aRng.Areas(aRng.Areas.Count)
Set FirstCell = .Cells(.Cells.Count)
'This little 'dance' ensures we get the first matching _
cell in the range first
End With
Set FirstCell = aRng.Find(What:=What, After:=FirstCell, _
LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, _
MatchByte:=MatchByte, SearchFormat:=SearchFormat)
If FirstCell Is Nothing Then Exit Function '*****
Set CurrCell = FirstCell
Set FindAll = CurrCell
Do
Set FindAll = Application.Union(FindAll, CurrCell)
'Setting FindAll at the top of the loop ensures _
the result is arranged in the same sequence as _
the matching cells; the duplicate assignment of _
the first matching cell to FindAll being a small _
price to pay for the ordered result
Set CurrCell = aRng.Find(What:=What, After:=CurrCell, _
LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, _
MatchByte:=MatchByte, SearchFormat:=SearchFormat)
'FindNext is not reliable because it ignores the FindFormat settings
Loop Until CurrCell.Address = FirstCell.Address
End Function |
