Discussion :

[jujudeo]

Bonjour,

voila j'ai fait le tour des forums mais je ne trouve pas la solution a une manip très basique

j'aimerais copier les valeurs de cellules non vides vers une autre feuille exactement au même endroit ! En soit très simple, mais je n'arrive pas a "coller" exactement au même endroit.

je sais que mon problème est ici

Code :

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

Sheets("TOTAL").Range("H5:NI27").PasteSpecial xlPasteAll

la plage sur laquelle je veux coller est celle-ci

Code :

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

Sheets("TOTAL").Range("H5:NI27")

je vous laisse mon code en dessous et je vous remercie par avance !!

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub copiercoler()
Dim myRange As Range
Dim cell As Range
 
Set myRange = Sheets("RECUP").Range("H5:NI27")
For Each cell In myRange
    If cell <> "" Then
    cell.Copy
    Sheets("TOTAL").Range("H5:NI27").PasteSpecial xlPasteAll
    End If
Next cell
 
End Sub

[Invité]

Bonjour,

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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
Sub CopierColler()
 
' Copie les cellules avec leurs propriétés : plus long.
 
Dim I As Long
Dim MyRangeSource As Range, MyRangeCible As Range
 
    Set MyRangeSource = Sheets("RECUP").Range("H5:NI27")
    Set MyRangeCible = Sheets("TOTAL").Range("H5:NI27")
 
    For I = 1 To MyRangeSource.Count
        If MyRangeSource(I) <> "" Then
           MyRangeSource(I).Copy Destination:=MyRangeCible(I)
        End If
    Next I
 
    Set MyRangeSource = Nothing
    Set MyRangeCible = Nothing
 
End Sub
 
 
Sub CopierCollerContenu()
 
' Copie uniquement le contenu : plus rapide.
 
Dim I As Long
Dim MyRangeSource As Range, MyRangeCible As Range
 
    Set MyRangeSource = Sheets("RECUP").Range("H5:NI27")
    Set MyRangeCible = Sheets("TOTAL").Range("H5:NI27")
 
    For I = 1 To MyRangeSource.Count
        If MyRangeSource(I) <> "" Then MyRangeCible(I) = MyRangeSource(I)
    Next I
 
    Set MyRangeSource = Nothing
    Set MyRangeCible = Nothing
 
End Sub

[jujudeo]

Salut Eric, effectivement cela marche si je n'avais pas de propriété !!

Or, je dois copié le contenu de la cellule mais aussi le remplissage. j'ai trouvé par une autre personne ". adresse" une fonction que je ne connaissais pas du tout et qui marche super bien
Du coup mon code est le suivant :

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
Sub copiercoler()
Dim myRange As Range
Dim cell As Range
 
Sheets("C.P").Range("H5:NI27").Copy
Sheets("TOTAL").Range("H5:NI27").PasteSpecial xlPasteAll
 
Set myRange = Sheets("C.P").Range("H5:NI27")
For Each cell In myRange
    If cell <> "" Then
    cell.Copy Sheets("TOTAL").Range(cell.Address)
    End If
Next cell
 
Set myRange = Sheets("RECUP").Range("H5:NI27")
For Each cell In myRange
    If cell <> "" Then
    cell.Copy Sheets("TOTAL").Range(cell.Address)
    End If
Next cell
 
Set myRange = Sheets("ARRET").Range("H5:NI27")
For Each cell In myRange
    If cell <> "" Then
    cell.Copy Sheets("TOTAL").Range(cell.Address)
    End If
Next cell
 
Set myRange = Sheets("EV. FAM.").Range("H5:NI27")
For Each cell In myRange
    If cell <> "" Then
    cell.Copy Sheets("TOTAL").Range(cell.Address)
    End If
Next cell
 
Set myRange = Sheets("SANS SOLDE").Range("H5:NI27")
For Each cell In myRange
    If cell <> "" Then
    cell.Copy Sheets("TOTAL").Range(cell.Address)
    End If
Next cell
 
End Sub

J'ai 5 feuilles du coup il a l'air un peu fastidieux. Il marche très bien mais je ne sais pas s'il est possible de l'optimiser étant donner que je réalise la même chose sur 5 feuilles...

[Patrice740]

Il marche très bien mais je ne sais pas s'il est possible de l'optimiser étant donner que je réalise la même chose sur 5 feuilles...

Bonjour,

Tu boucler une seule fois :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub copiercoler()
Dim myRange As Range
Dim cell As Range
  Worksheets("C.P").Range("H5:NI27").Copy Worksheets("TOTAL").Range("H5")
  Set myRange = Worksheets("TOTAL").Range("H5:NI27")
  For Each cell In myRange
    If Worksheets("RECUP").Range(cell.Address) <> "" Then Worksheets("RECUP").Range(cell.Address).Copy cell
    If Worksheets("ARRET").Range(cell.Address) <> "" Then Worksheets("RECUP").Range(cell.Address).Copy cell
    If Worksheets("EV. FAM.").Range(cell.Address) <> "" Then Worksheets("RECUP").Range(cell.Address).Copy cell
    If Worksheets("SANS SOLDE").Range(cell.Address) <> "" Then Worksheets("RECUP").Range(cell.Address).Copy cell
  Next cell
End Sub