Discussion :

[gilles171]

Bonjour,

Je comprends pas pourquoi mon code de copier coller (en rouge D1=> K1) une date, ne marche pas, pourtant tout semble OK ?

Pouvez vous m'aider svp ?

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
Sub TraitementSheet(Sh As Worksheet)
Dim Plage As Range
Dim Cel As Range
 
  Range("D1").Copy
 Range("K1").Activate
 ActiveSheet.Paste

 If UCase(Left(Sh.Name, 5)) <> UCase("Valor") Then Exit Sub

Set Plage = Sh.Range(Sh.Cells(2, 1), Sh.Cells(Sh.Rows.Count, 1).End(xlUp))

For Each Cel In Plage
    'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
 
    If Trim("" & Cel.Value) <> "" And Trim("" & Cel.Offset(0, 1).Value) <> "" And Trim("" & Cel.Offset(0, 5).NumberFormat) = "0.00%" Then
        Cel.Offset(, 10).Value = Cel.Offset(, 6).Value
 
    'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
    ElseIf Cel.Value <> "" And Cel.Offset(0, 1).Value <> "" And Cel.Offset(0, 5).NumberFormat <> "0%" Then
        Cel.Offset(, 10).Value = Cel.Offset(, 5).Value
        

 
    End If
 

Next
End Sub

Merci beaucoup.

Cordialement,

[Slooby]

Bonjour,

Pourquoi écrire 3 lignes de code dégueulasses quand on peut en faire qu'une propre ?

Code :

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

Range("D1").Copy Destination:=Range("K1")

Surtout que sur le web il y a déjà des tonnes de sujet qui répondent à ça !

Slooby

[gilles171]

J'ai tout essayé sur le net ! Dont le tiens qui ne marche pas ! Pourtant ca marche pas .... Voici le code complet :

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
Option Explicit
Sub Test()
Dim Plage As Range, InpRng As Range
Dim Cel As Range
'On Error GoTo Err_Read
Dim Derl As Long
Derl = ThisWorkbook.Worksheets("Mensuel").Range("A" & Cells.Rows.Count).End(xlUp).Row
Set InpRng = ThisWorkbook.Worksheets("Mensuel").Range("A2:A" & Derl)
Debug.Print InpRng.Address, InpRng.Cells.Count
For Each Cel In InpRng
    If Trim("" & Cel) <> "" Then Histo CStr(Cel) Else MsgBox Cel.Address & " invalide"
Next
End Sub
Sub Histo(Fichier As String)
Dim Sh As Worksheet
Dim wb As Workbook
Application.DisplayAlerts = False
Set wb = Workbooks.Open(Fichier)
Application.DisplayAlerts = True
For Each Sh In wb.Sheets
    TraitementSheet Sh
Next
wb.Save
wb.Close
End Sub
Sub TraitementSheet(Sh As Worksheet)
Dim Plage As Range
Dim Cel As Range
 
Range("D1").Copy Destination:=Range("K1")

 If UCase(Left(Sh.Name, 5)) <> UCase("Valor") Then Exit Sub

Set Plage = Sh.Range(Sh.Cells(2, 1), Sh.Cells(Sh.Rows.Count, 1).End(xlUp))

For Each Cel In Plage
    'Condition 1) Si colonne A, B, non vide et si colonne F est en % alors copier E dans G
 
    If Trim("" & Cel.Value) <> "" And Trim("" & Cel.Offset(0, 1).Value) <> "" And Trim("" & Cel.Offset(0, 5).NumberFormat) = "0.00%" Then
        Cel.Offset(, 10).Value = Cel.Offset(, 6).Value
 
    'Condition 2 ) Si colonne A, B, non vide, et si colonne F n'est pas en % alors copier F dans G
    ElseIf Cel.Value <> "" And Cel.Offset(0, 1).Value <> "" And Cel.Offset(0, 5).NumberFormat <> "0%" Then
        Cel.Offset(, 10).Value = Cel.Offset(, 5).Value
        

 
    End If
 

Next
End Sub

[Slooby]

Et avec:

Code :

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

Sh.Range("D1").Copy Destination:=Sh.Range("K1")

ça donne quoi ?

J'ai déjà eu des erreurs de copié/collé avec l'objet WorkSheet.
Dans le PIRE des cas (à faire le moins souvent possible !!!), active ta feuille avant de faire ton copié/collé:

Code :

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

1
2
Sh.Activate
Range("D1").Copy Destination:=Range("K1")

Slooby

[gilles171]

Merci beaucoup !!!
Ca marche 100% parfait