Range erreur 1004 (copier ds different clas)

Fermé
Lmqt - 4 déc. 2008 à 17:35
 Lmqt - 4 déc. 2008 à 17:40
Bonjour,
je coince sur une macro.
La macro fonctionne de la manière suivante :
1) Sélection du fichier d'import par ouverture de fenêtre
2) si la date du fichier cible dans la ligne 84 = date du fichier source dans la colonne 4 copier la les 40 lignes de la même colonne du fichier source dans les 40 colonnes de la même ligne du fichier cible (La macro tourne si je fais un copier coller ligne / ligne mais prends 15 mins pour un mois ce qui n'est pas utilisable)
si ce n'est pas le cas on passe dans la colonne suivante du fichier source puis dans l'onglet suivant. L'opération continue pour le jour âpres dans le fichier cible et se répète pour 240 jours.

Erreur : A partir de la ligne en gras mais peut etre aussi pour la ligne juste en dessous j'ai une erreur 1004 "erreur definie par l'application ou par l'objet"


Merci d'avance pour votre aide.
Sebastien

Si vous avez des suggestions je suis prenneur a 100% comme vous le voyez je balbutie en VBA et mon code est très basic :/

Sub Retraitement()

'Debut du rapatriment de N-1

Dim shA As Worksheet 'Feuille destination Base
Dim wB As Workbook 'Ouverture meteo source
Dim filename
Dim onglet As Integer
Dim ColRefOld As Integer
Dim jourNew As Integer
Dim LigneDate As Integer

'Ouvre la boite de dialogue choix du fichier
filename = Application.GetOpenFilename("Excel Files(*.xls), *.*", , "Selectionnez le Fichier Météo N-1")
If Not filename = "" Then
End If


Set shA = Sheets("PortN-1")
Set wB = Workbooks.Open(filename:=filename)

Dim MyName As String
MyName = wB.Name


ColRefOld = 6
jourNew = 8
onglet = 7
ligneold = 228
colonnenew = 5

Do While jourNew <= 240
Do While onglet <= 8
Do While ColRefOld <= 40
Do While ligneold <= 267

If Workbooks(MyName).Sheets("oct 09").Range(84, ColRefOld) = "1" Then
Workbooks(MyName).Sheets("oct 08").Range("ColRefOld,ligneold").Copy
shA.Range(jourNew, colonnenew).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

'copie les valeurs si nescessaire
ligneold = ligneold + 1
colonnenew = colonnenew + 1
Loop
'passe au jour suivant old
ColRefOld = ColRefOld + 1
ligneold = 228
colonnenew = 5
Loop
'passe a l'onglet suivant
ColRefOld = 1
onglet = onglet + 1
Loop
'passe au jour suivant new
onglet = 1
ColRefOld = 1
jourNew = jourNew + 1

Loop



wB.Close False ' ferme sans sauver


Set wB = Nothing
Set shA = Nothing
Set shB = Nothing
End Sub
Sub Macro5()

'Debut du rapatriment de N-1

Dim shA As Worksheet 'Feuille destination Base
Dim wB As Workbook 'Ouverture meteo source
Dim filename
Dim onglet As Integer
Dim ColRefOld As Integer
Dim jourNew As Integer
Dim LigneDate As Integer

'Ouvre la boite de dialogue choix du fichier
filename = Application.GetOpenFilename("Excel Files(*.xls), *.*", , "Selectionnez le Fichier Météo N-1")
If Not filename = "" Then
End If


Set shA = Sheets("PortN-1")
Set wB = Workbooks.Open(filename:=filename)

Dim MyName As String
MyName = wB.Name





ColRefOld = 6
jourNew = 8
onglet = 6
ligneold = 228
colonnenew = 4



Do While jourNew <= 240
Do While onglet <= 6
Do While ColRefOld <= 8

Set oldR = Workbooks(MyName).Sheets(onglet)


If Workbooks(MyName).Sheets(onglet).Cells(84, ColRefOld) = shA.Cells(jourNew, 3).Value Then
oldR.Range(Cells(228, ColRefOld), Cells(268, ColRefOld)).Copy
shA.Range(jourNew, colonnenew).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

'passe au jour suivant old
ColRefOld = ColRefOld + 1
ligneold = 228
colonnenew = 5
Loop
'passe a l'onglet suivant
ColRefOld = 1
onglet = onglet + 1
Loop
'passe au jour suivant new
onglet = 1
ColRefOld = 1
jourNew = jourNew + 1

Loop



wB.Close False ' ferme sans sauver


Set wB = Nothing
Set shA = Nothing
Set shB = Nothing
End Sub


Merci pour votre aide

1 réponse

Toutes mes excuses j'ai mis un mauvais copier coller cette version est celle que j'utilise. (désolé je n'ai pas vu de boutton éditer :/)

Sub retraitement()

'Debut du rapatriment de N-1

Dim shA As Worksheet 'Feuille destination Base
Dim wB As Workbook 'Ouverture meteo source
Dim filename
Dim onglet As Integer
Dim ColRefOld As Integer
Dim jourNew As Integer
Dim LigneDate As Integer

'Ouvre la boite de dialogue choix du fichier
filename = Application.GetOpenFilename("Excel Files(*.xls), *.*", , "Selectionnez le Fichier source")
If Not filename = "" Then
End If


Set shA = Sheets("PortN-1")
Set wB = Workbooks.Open(filename:=filename)

Dim MyName As String
MyName = wB.Name


ColRefOld = 6
jourNew = 8
onglet = 7
ligneold = 228
colonnenew = 5

Do While jourNew <= 240
Do While onglet <= 8
Do While ColRefOld <= 40
Do While ligneold <= 267

If Workbooks(MyName).Sheets("oct 09").Range(84, ColRefOld) = "1" Then
Workbooks(MyName).Sheets("oct 08").Range("ColRefOld,ligneold").Copy
shA.Range(jourNew, colonnenew).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

'copie les valeurs si nescessaire
ligneold = ligneold + 1
colonnenew = colonnenew + 1
Loop
'passe au jour suivant old
ColRefOld = ColRefOld + 1
ligneold = 228
colonnenew = 5
Loop
'passe a l'onglet suivant
ColRefOld = 1
onglet = onglet + 1
Loop
'passe au jour suivant new
onglet = 1
ColRefOld = 1
jourNew = jourNew + 1

Loop



wB.Close False ' ferme sans sauver


Set wB = Nothing
Set shA = Nothing
Set shB = Nothing
End Sub
Sub Macro5()

'Debut du rapatriment de N-1

Dim shA As Worksheet 'Feuille destination Base
Dim wB As Workbook 'Ouverture meteo source
Dim filename
Dim onglet As Integer
Dim ColRefOld As Integer
Dim jourNew As Integer
Dim LigneDate As Integer

'Ouvre la boite de dialogue choix du fichier
filename = Application.GetOpenFilename("Excel Files(*.xls), *.*", , "Selectionnez le Fichier Météo N-1")
If Not filename = "" Then
End If


Set shA = Sheets("PortN-1")
Set wB = Workbooks.Open(filename:=filename)

Dim MyName As String
MyName = wB.Name





ColRefOld = 6
jourNew = 8
onglet = 6
ligneold = 228
colonnenew = 4



Do While jourNew <= 240
Do While onglet <= 6
Do While ColRefOld <= 8

Set oldR = Workbooks(MyName).Sheets(onglet)


If Workbooks(MyName).Sheets(onglet).Cells(84, ColRefOld) = shA.Cells(jourNew, 3).Value Then
oldR.Range(Cells(228, ColRefOld), Cells(268, ColRefOld)).Copy
shA.Range(jourNew, colonnenew).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

'passe au jour suivant old
ColRefOld = ColRefOld + 1
ligneold = 228
colonnenew = 5
Loop
'passe a l'onglet suivant
ColRefOld = 1
onglet = onglet + 1
Loop
'passe au jour suivant new
onglet = 1
ColRefOld = 1
jourNew = jourNew + 1

Loop



wB.Close False ' ferme sans sauver


Set wB = Nothing
Set shA = Nothing
Set shB = Nothing
End Sub
0