Copier/coller une plage de cellules

franckylecake · 22 Février 2010

Bonjour à tous,

Dans le cadre de mon travail, je dois réaliser un code permettant d'automatiser un copier / coller d'une plage de cellules entre 2 classeurs. Etant un novice bidouilleur, j'ai réussi à pondre à code mais je me fais jeter à chaque exécution de ce code avec toujours la même erreur : "1004".

Je souhaite copier une plage de cellule du fichier NomFichier1 dans mon fichier. Etant susceptible de rajouter des lignes et des colonnes, la plage à copier doit être dynamique:

Plage à copier dans le classeur NomFichier1 :
Cellule (L_savings,C_savings) à la cellule (Lbis_savings,Cbis_savings)

Coller dans la plage (classeur actif):
Cellule(L,C) à la cellule(Lbis,Cbis)

J'ai testé mes différentes variables et elles renvoient les bons numéros de lignes te colonnes. De plus, je pense que mon code est simplifiable étant donné que je n'utilise pas les fonctions de recherches d'adresses des cellules.

Comment faire pour faire fonctionner ce code?

D'avance merci pour votre aide.

Sub ImporterOnglet()

Dim NomFichier1 As Variant
Dim NomDernièreInitiative As Variant
Dim Q As Long
Dim L As Integer'première ligne de reception des données
Dim Lbis As Integer 'dernière ligne de reception des données
Dim C As Integer 'première colonne de reception des données
Dim Cbis As Integer 'dernière colonne de reception des données
Dim L_savings As Long 'première ligne à copier
Dim Lbis_savings As Long 'dernière ligne à copier
Dim C_savings As Long 'première colonne à copier
Dim Cbis_savings As Long 'dernière colonne à copier

NomFichier1 = ActiveWorkbook.Sheets("Paramètre").Cells(1, 2).Value
NomDernièreInitiative = ActiveWorkbook.Sheets("Paramètre").Cells(2, 2).Value

Q = MsgBox("Avez-vous mis à jour l'onglet Paramètre ?", vbYesNo)

If (Q = 6) Then

L = Cells.Find(What:="Weighted savings ATF + AFS + AF 2010-2013", After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Row

Lbis = Cells.Find(What:=NomDernièreInitiative, After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Row

C = Cells.Find(What:="Weighted savings ATF + AFS + AF 2010-2013", After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Column

Cbis = Cells.Find(What:="One time Savings AF 2013", After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Column

Cter = Cells.Find(What:="Status", After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Column

Cquater = Cells.Find(What:="Complexity", After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Column

L_savings = Workbooks(NomFichier1).Sheets("Paramètre").Range("B3").Value

Lbis_savings = Workbooks(NomFichier1).Sheets("Paramètre").Range("B4").Value

C_savings = Workbooks(NomFichier1).Sheets("Paramètre").Range("B5").Value

Cbis_savings = Workbooks(NomFichier1).Sheets("Paramètre").Range("B6").Value

Workbooks(NomFichier1).Sheets("Initiatives Lead Chart").Range(Cells(L_savings, C_savings), Cells(Lbis_savings, Cbis_savings)).Value.Copy
ActiveWorkbook.Sheets("Initiatives Lead Chart").Range(Cells(L, C), Cells(Lbis, Cbis)).PasteSpecial (xlPasteValues)

MsgBox "La mise à jour est effectuée"

Else

MsgBox "Veuillez mettre à jour le nom du fichier dans l'onglet Paramètre"

End If

End Sub

Roland_M · 22 Février 2010

Re : Copier/coller une plage de cellules

bonjour

essais ce code un peu plus clair et voir pour la suite !?

Code:

'les variables me semble pas bien définit
'Reponse = Variant et Test If Reponse = vbTes ou vbNo ou autre ....
'NomDernInitiative = String
'NomDuFichier = String <<<<< il était variant !?
'c'est du type boolean vrai/faux c'est tout ! ne pas confondre avec variant !
'
'NomDernInitiative ne semble pas servir !!!!!?????
'
'essais toujours comme ceci avec des var plus significatives
'ensuite faire exécution pas à pas avec F8 et voir ou ça plante !
'pour nous informer car on ne peut pas l'essayer ainsi

Sub ImporterOnglet()
Dim Reponse As Variant
Dim NomDuFichier As String
Dim NomDernInitiative As String
Dim PremLigReceptDon As Integer
Dim DernLigReceptDon As Integer
Dim PremColReceptDon As Integer
Dim DernColReceptDon As Integer
Dim PremLigReceptDon_save As Long
Dim DernLigReceptDon_save As Long
Dim PremColReceptDon_save As Long
Dim DernColReceptDon_save As Long

NomDuFichier = ActiveWorkbook.Sheets("Paramètre").Cells(1, 2).Value
NomDernInitiative = ActiveWorkbook.Sheets("Paramètre").Cells(2, 2).Value

Reponse = MsgBox("Avez-vous mis à jour l'onglet Paramètre ?", vbYesNo)
If Reponse <> vbYes Then
   MsgBox "Veuillez mettre à jour le nom du fichier dans PremLigReceptDon'onglet Paramètre"
   Exit Sub
End If

'suite si ok ...
PremLigReceptDon = Cells.Find(What:="Weighted savings ATF + AFS + AF 2010-2013", After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row

DernLigReceptDon = Cells.Find(What:=NomDernièreInitiative, After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row

PremColReceptDon = Cells.Find(What:="Weighted savings ATF + AFS + AF 2010-2013", After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Column

DernColReceptDon = Cells.Find(What:="One time Savings AF 2013", After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Column

Cter = Cells.Find(What:="Status", After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Column

Cquater = Cells.Find(What:="Complexity", After:=Range("B6"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Column

PremLigReceptDon_save = Workbooks(NomDuFichier).Sheets("Paramètre").Range(" B3").Value
DernLigReceptDon_save = Workbooks(NomDuFichier).Sheets("Paramètre").Range(" B4").Value
PremColReceptDon_save = Workbooks(NomDuFichier).Sheets("Paramètre").Range(" B5").Value
DernColReceptDon_save = Workbooks(NomDuFichier).Sheets("Paramètre").Range(" B6").Value

Workbooks(NomDuFichier).Sheets("Initiatives Lead Chart").Range(Cells(PremLigReceptDon_save, PremColReceptDon_save), Cells(DernLigReceptDon_save, DernColReceptDon_save)).Value.Copy
ActiveWorkbook.Sheets("Initiatives Lead Chart").Range(Cells(PremLigReceptDon, PremColReceptDon), Cells(DernLigReceptDon, DernColReceptDon)).PasteSpecial (xlPasteValues)

MsgBox "La mise à jour est effectuée"
End Sub

franckylecake · 23 Février 2010

Re : Copier/coller une plage de cellules

Bonjour Roland,

Marci pour tes corrections. Le code est effectivement plus clair. J'ai testé la macro comem tu me l'as conseillé mais l'erreur '1004' persiste sur la ligne :

Workbooks(NomDuFichier).Sheets("Initiatives Lead Chart").Range(Cells(PremLigReceptDon_save, PremColReceptDon_save), Cells(DernLigReceptDon_save, DernColReceptDon_save)).Value.Copy

J'ai pris soin de redéclarer mes variables das les 2 classeurs afin que toutes les variables soient de même type. Je pense que la macro ne trouve pas la zone à copier. J'ai fait des tests afind e voir si la macro pouvait aller chercher la valeur d'1 cellule dans la zone et cela fonctionne. Dès que je passe une plage à 4 cellules, cela ne fonctionne plus.

Pour des questions de confidentialité je n'ai pas le droit de diffuser ces 2 classeurs.

D'avance merci pour ton aide.

Franck.

Roland_M · 23 Février 2010

Re : Copier/coller une plage de cellules

re

j'ai un petit doute !
essais comme ceci de modifier au bout > .Value.Copy en > .Copy

soit :

Workbooks(NomDuFichier).Sheets("Initiatives Lead Chart").Range(Cells(PremLigReceptDon_save, PremColReceptDon_save), Cells(DernLigReceptDon_save, DernColReceptDon_save)).Copy

sinon vérifier les valeurs avec Msgbox exemple :
Msgbox PremLigReceptDon_save & " " & PremColReceptDon_save . . .

franckylecake · 25 Février 2010

Re : Copier/coller une plage de cellules

J'ai intégré ces modifications mais le problème persiste. Je vais essayer une autre méthode afin de pouvoir faire fonctionner la macro et la rendre exploitable par mes collègues.

En tout cas merci pour ton aide.

Franck

franckylecake · 25 Février 2010

Re : Copier/coller une plage de cellules

J'ai effectué des tests et il s'avère que ma première ligne de code ne foncitonne pas (erreur 1004) mais al seconde fonctionne alors que els coordonnées (4,17) correspondent à la cellule P4.

Workbooks(NomDuFichier).Sheets("Initiatives Lead Chart").Range(Cells(4, 17)).copy

Workbooks(NomDuFichier).Sheets("Initiatives Lead Chart").Range("P4").copy

Effectuez une recherche sur Excel Downloads...

Copier/coller une plage de cellules

franckylecake

XLDnaute Nouveau

Roland_M

XLDnaute Barbatruc

franckylecake

XLDnaute Nouveau

Roland_M

XLDnaute Barbatruc

franckylecake

XLDnaute Nouveau

franckylecake

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums