A voir également:
- Range erreur 1004 (copier ds different clas)
- Erreur 0x80070643 - Guide
- Copier une vidéo youtube - Guide
- Signe différent - Forum Bureautique
- Erreur d'execution 1004 ✓ - Forum Excel
- Comment écrire le signe mathématique "différent de"? - Forum Bureautique
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
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