Bonsoir à tous.
Voici le sujet, je souhaite que des données saisies dans le classeur1 soient recopiées simultanément dans le classeur2 et sous conditions. Je vais essayer d'être clair. Les données du classeur1 des colonnes A,B,C,D,E,et F sont à recopier respectivement dans les colonnes A,C,D,F et E du classeur2 et à condition que les valeurs colonne C du classeur1 soient <> "Esp". Les plages de saisies pour les 2 classeurs s'étendent des lignes 7 à 85.
Voici ce que j'ai fait :
Sub maj()
Dim Asso As Workbook
Set Asso = GetObject("I:\Asso.xls")
Dim i As Long
For i = 7 To 85
If Workbooks("Classeur1").Sheets("Janv").Range("C" & i) <> "Esp" Then
Asso.Sheets("CCM").Range("A" & i) = Workbooks("Classeur1").Sheets("Janv").Range("A" & i)
Asso.Sheets("CCM").Range("C" & i) = Workbooks("Classeur1").Sheets("Janv").Range("B" & i)
Asso.Sheets("CCM").Range("D" & i) = Workbooks("Classeur1").Sheets("Janv").Range("C" & i)
Asso.Sheets("CCM").Range("E" & i) = Workbooks("Classeur1").Sheets("Janv").Range("F" & i)
Asso.Sheets("CCM").Range("F" & i) = Workbooks("Classeur1").Sheets("Janv").Range("E" & i)
End If
Next
End Sub
ça fonctionne ,mais il est évident que pour les valeurs = "Esp" j'ai des lignes blanches dans la feuille du classeur2 et pour éviter ce problème, je viens vous demander un peu d'aide.
Est-il possible d'associer ce bout de code avec le suivant:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range
Set plage = Range("D" & Target.Row)
If Not Intersect(Target, Columns("D")) Is Nothing Then
If plage.Value >= 7000 And plage.Value < 8000 Then plage.Font.ColorIndex = 1
If plage.Value >= 7000 And plage.Value < 8000 Then Target.Offset(0, 1).Select
If plage.Value >= 6000 And plage.Value < 7000 Then plage.Font.ColorIndex = 3
If plage.Value >= 6000 And plage.Value < 7000 Then Target.Offset(0, 2).Select
End If
End Sub
Voici le sujet, je souhaite que des données saisies dans le classeur1 soient recopiées simultanément dans le classeur2 et sous conditions. Je vais essayer d'être clair. Les données du classeur1 des colonnes A,B,C,D,E,et F sont à recopier respectivement dans les colonnes A,C,D,F et E du classeur2 et à condition que les valeurs colonne C du classeur1 soient <> "Esp". Les plages de saisies pour les 2 classeurs s'étendent des lignes 7 à 85.
Voici ce que j'ai fait :
Sub maj()
Dim Asso As Workbook
Set Asso = GetObject("I:\Asso.xls")
Dim i As Long
For i = 7 To 85
If Workbooks("Classeur1").Sheets("Janv").Range("C" & i) <> "Esp" Then
Asso.Sheets("CCM").Range("A" & i) = Workbooks("Classeur1").Sheets("Janv").Range("A" & i)
Asso.Sheets("CCM").Range("C" & i) = Workbooks("Classeur1").Sheets("Janv").Range("B" & i)
Asso.Sheets("CCM").Range("D" & i) = Workbooks("Classeur1").Sheets("Janv").Range("C" & i)
Asso.Sheets("CCM").Range("E" & i) = Workbooks("Classeur1").Sheets("Janv").Range("F" & i)
Asso.Sheets("CCM").Range("F" & i) = Workbooks("Classeur1").Sheets("Janv").Range("E" & i)
End If
Next
End Sub
ça fonctionne ,mais il est évident que pour les valeurs = "Esp" j'ai des lignes blanches dans la feuille du classeur2 et pour éviter ce problème, je viens vous demander un peu d'aide.
Est-il possible d'associer ce bout de code avec le suivant:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range
Set plage = Range("D" & Target.Row)
If Not Intersect(Target, Columns("D")) Is Nothing Then
If plage.Value >= 7000 And plage.Value < 8000 Then plage.Font.ColorIndex = 1
If plage.Value >= 7000 And plage.Value < 8000 Then Target.Offset(0, 1).Select
If plage.Value >= 6000 And plage.Value < 7000 Then plage.Font.ColorIndex = 3
If plage.Value >= 6000 And plage.Value < 7000 Then Target.Offset(0, 2).Select
End If
End Sub