bonjour

me revoila; j'ai mis un peu de temps mais je suis parvenu à faire ce que je recherchais

Ci joint le programme que j'ai réalisé. Il est un peu long si les données sont nombreuses. peut on simplifier et accelerer le mouvement?
par ailleurs, ce n'est pas encore tout à fait au point. En effet, je voudrais que ces donnees mises en forme nourrissent une base de donnee (excel) c'est à dire se copient à la suite des précedentes sans les effacer. (Exemple: les n lignes de la feuille se mettent automatiquement à la suite des m lignes du fichier precedent.Pouvez vous m'aider? (deux colonnes sont à exclure lors de ce procede)
Merci de votre aide


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
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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
Sub transfert()
Dim Ligne_lue As Long
Ligne_lue = 2 'initialisation de la variable
'separateur des cellule plaquette
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("IMPORT DU TERRAIN").Select
    Cells(Ligne_lue, 1).Select
    Selection.Copy
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 4).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Selection.TextToColumns Destination:=Sheets("Feuil1").Cells(Ligne_lue, 4), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    Ligne_lue = Ligne_lue + 1
Wend
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("IMPORT DU TERRAIN").Select
    Cells(Ligne_lue, 2).Select
    Selection.Copy
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 3).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Ligne_lue = Ligne_lue + 1
Wend
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 1) = Ligne_lue - 1
    Ligne_lue = Ligne_lue + 1
Wend
'recherche du code de l'essence
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 2).FormulaR1C1 = "=VLOOKUP(RC[1],qualite!R2C4:R28C5,1)"
    Ligne_lue = Ligne_lue + 1
Wend
 
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("IMPORT DU TERRAIN").Select
    Cells(Ligne_lue, 3).Select
    Selection.Copy
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 7).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Ligne_lue = Ligne_lue + 1
Wend
 
'Operation sur diametre en m
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 8).FormulaR1C1 = "='IMPORT DU TERRAIN'!RC[-3]/100"
    Ligne_lue = Ligne_lue + 1
Wend
 
'Conditions pour ID IT
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 6).FormulaR1C1 = "=IF(RC[-1]="""","""",IF(RC[-1]<90,""ID"",""IT""))"
    Ligne_lue = Ligne_lue + 1
Wend
 
'reduction longueur en m
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 9).FormulaR1C1 = _
        "=IF('IMPORT DU TERRAIN'!RC[-5]=0,0,'IMPORT DU TERRAIN'!RC[-5]/100)"
    Ligne_lue = Ligne_lue + 1
Wend
 
'Qualité
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 10).FormulaR1C1 = _
        "=VLOOKUP('IMPORT DU TERRAIN'!RC[-3],qualite!R2C1:R13C2,2)"
    Ligne_lue = Ligne_lue + 1
Wend
 
'calcul pieces
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 11).FormulaR1C1 = "=IF(RC[-5]=""ID"",0,1)"
    Ligne_lue = Ligne_lue + 1
Wend
 
'Calcul mesures
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 12).FormulaR1C1 = "=IF(RC[-4]<>0,1,0)"
    Ligne_lue = Ligne_lue + 1
Wend
 
'Calcul grumes
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 13).FormulaR1C1 = "=IF(RC[-7]="""",1,0)"
    Ligne_lue = Ligne_lue + 1
Wend
 
'Calcul volume net
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 14).FormulaR1C1 = "=ROUND((RC[-7]-RC[-5])*RC[-6]*RC[-6]*PI()/4,3)"
    Ligne_lue = Ligne_lue + 1
Wend
 
'Calcul volume brut
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 15).FormulaR1C1 = "=ROUND(RC[-8]*RC[-7]*RC[-7]*PI()/4,3)"
    Ligne_lue = Ligne_lue + 1
Wend
 
'Nom propriétaire
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
Sheets("IMPORT DU TERRAIN").Select
    Range("A1").Select
    Selection.Copy
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 17).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Ligne_lue = Ligne_lue + 1
Wend
 
'Parcelle
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("IMPORT DU TERRAIN").Select
    Range("B1").Select
    Selection.Copy
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 18).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Ligne_lue = Ligne_lue + 1
Wend
 
'Date
Ligne_lue = 2 'initialisation de la variable
While Sheets("IMPORT DU TERRAIN").Cells(Ligne_lue, 1) <> ""
    Sheets("IMPORT DU TERRAIN").Select
    Range("C1").Select
    Selection.Copy
    Sheets("Feuil1").Select
    Cells(Ligne_lue, 19).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone
    Ligne_lue = Ligne_lue + 1
Wend
 
End Sub