Probleme Paste Special

Bonjour
Je voudrais récupérer des données d'un fichier A et les copier en valeur et en format dans un fichier B

j'ai effectué pour cela le code suivant

Code:

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
Sub Copie_données(Fichier_base As String, fichier_consolidé As String)
 
Dim nbligne As Integer
Dim classeurActif As Workbook
 
Set classeurActif = Nothing
Set classeurActif = Ouvre(Fichier_base)
 
' pour le CA
nbligne = classeurActif.Worksheets("CA RI").Range("B65536").End(xlUp).Row
 
Sheets("CA RI").Select
Range("A4:CI" & nbligne).Select
Selection.Copy
ActiveWorkbook.Close savechanges:=False
Application.Visible = True
 
Set classeurActif = Ouvre(fichier_consolidé)
Workbooks("Maquette_CA_RI_Conso.xlsm").Activate
Sheets("CA RI").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Selection.PasteSpecial Paste:=xlValues
    'Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    '    xlNone, SkipBlanks:=False, Transpose:=False
 
Call MajTCD(classeurActif)
ActiveWorkbook.Close savechanges:=True
 
Application.Visible = True
Application.DisplayAlerts = False
Set classeurActif = Nothing
 
 
'concernant l'emploi ressource
Set classeurActif = Nothing
Set classeurActif = Ouvre(Fichier_base)
 
nbligne = classeurActif.Worksheets("Emploi Ressources").Range("B65536").End(xlUp).Row
If nbligne > 4 Then
 
'MsgBox nbligne
 
Sheets("Emploi Ressources").Select
Range("A4:CI" & nbligne).Select
Selection.Copy
ActiveWorkbook.Close savechanges:=False
Application.Visible = True
 
Set classeurActif = Ouvre(fichier_consolidé)
Workbooks("Maquette_CA_RI_Conso.xlsm").Activate
Sheets("Emploi Ressources").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
'Selection.PasteSpecial Paste:=xlValues
 
   ' Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
 '       xlNone, SkipBlanks:=False, Transpose:=False
'ActiveSheet.Paste
 
Call MajTCD(classeurActif)
End If
 
 
ActiveWorkbook.Close savechanges:=True
 
Application.Visible = True
Application.DisplayAlerts = False
Set classeurActif = Nothing
 
End Sub

Et j'ai le message suivant la méthode Paste special de la classe Range à échouer..... alros que lorsque je fais un paste normal le code fonctionne correctement...

Est ce que quelqu'un pourrait m'aider car la je commence sérieusement à desespérer...

Cordialement

Essaies de travailler sans les Select

Exemple pour la première partie (et non ton code en entier)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Copie_données(Fichier_base As String, fichier_consolidé As String)
Dim NbLigne As Long
Dim WbkA As Workbook, WbkC As Workbook
Dim ShA As Worksheet, ShC As Worksheet
 
Application.ScreenUpdating = False
Set WbkA = Ouvre(Fichier_base)
Set ShA = WbkA.Worksheets("CA RI")
With ShA
    NbLigne = .Cells(.Rows.Count, "B").End(xlUp).Row
    Set WbkC = Ouvre(fichier_consolidé)
    Set ShC = WbkC.Worksheets("CA RI")
    .Range("A4:CI" & NbLigne).Copy ShC.Range("A4")
    ShC.Range("A4:CI" & NbLigne).Value = ShC.Range("A4:CI" & NbLigne).Value
    Set ShC = Nothing
End With
Set ShA = Nothing
WbkA.Close False
Set WbkA = Nothing
Call MajTCD(WbkC)
WbkC.Close savechanges:=True
Set WbkC = Nothing
End Sub

Merci pour ta réponse!! Oui effectivement j'avais un problème de select. Je fermais trop top le premier fichier.

Merci encore