Erreur sur code VBA - Décalage non voulu

Antho35

XLDnaute Occasionnel
Bonjour,

J'ai un petit souccit avec mon code vba contenu dans "fiches secteur"

Il y a un décalage, théoriquement mon tableau données démographique doit venir juste aprés le tableau 'les communes du secteur" si je met le code indiqué ci-après çà décale de façon anormal.

Qui a un petit idée, je pense que je n'en suis pas loin.

Code:
Dim test As Boolean 'déclare la variable test

Private Sub Worksheet_Change(ByVal Target As Range)
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim nl As Integer 'décalre la variable nl

If test = True Then Exit Sub 'si test est "vrai", sort de la procédure
If Target.Address <> "$J$2" Then Exit Sub 'si le chamgement a lieu ailleurs qu'en J2, sort de la procédure
Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
test = True 'définit la variable test
'efface les éventuelles anciennes données
If Range("C5") <> "DONNES DEMOGRAPHIQUE" Then Range("C5").CurrentRegion.Resize(Range("C5").CurrentRegion.Rows.Count + 1).EntireRow.Delete
Set o = Sheets("Bases Communes") 'définit l'onglet o
dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Rows 'définit la dernière ligne éditée dl de la colonne 1 (=A)
Set pl = o.Range("A2:D" & dl) 'définit la plage pl
o.Range("A2").AutoFilter Field:=5, Criteria1:=Target.Value 'filte le tableau par rapport au secteur
pl.SpecialCells(xlCellTypeVisible).Copy Range("C8") 'copie le tableau filtrée
nl = Range("C8").CurrentRegion.Rows.Count
o.Range("A2").AutoFilter 'supprime le filtre
Range("C5:G7").Cut
Range("C5:G7").Offset(nl + 4, 0).Insert Shift:=xlDown
test = False 'redéfinit la variable test
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub

Et voici le fichier.

Merci
 

Pièces jointes

  • Test 01.xlsx
    25.6 KB · Affichages: 75
  • Test 01.xlsx
    25.6 KB · Affichages: 83
  • Test 01.xlsx
    25.6 KB · Affichages: 81
Dernière édition:

Antho35

XLDnaute Occasionnel
Re : Erreur sur code VBA - Décalage non voulu

Bonjour,

Bloquage encor à un endroit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deddemo As Range
Dim derl As Long
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim nl As Integer 'décalre la variable nl

If test = True Then Exit Sub 'si test est "vrai", sort de la procédure

If Target.Address <> "$K$2" Then Exit Sub 'si le chamgement a lieu ailleurs qu'en J2, sort de la procédure

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
test = True 'définit la variable test

'efface les éventuelles anciennes données
If Range("A7") <> "DEMOGRAPHIE" Then
'efface les éventuelles anciennes données
derl = Range("A" & Rows.Count).End(xlUp).Row
Set debdemo = Range("A1:H" & derl).Find("DEMOGRAPHIE", LookIn:=xlValues)
If debdemo.Row > 7 Then plage = "5:" & debdemo.Row - 3
Rows(plage).Delete Shift:=xlUp
End If

Set o = Sheets("Bases Communes") 'définit l'onglet o
dl = o.Range("A" & Rows.Count).End(xlUp).Row

Set pl = o.Range("A2:H" & dl) 'définit la plage pl

dl = o.Range("A" & Rows.Count).End(xlUp).Row
Rows(6).Resize(nl - 1).Insert
Set pl = o.Range("A2:H" & dl) 'définit la plage pl
o.Range("A2").AutoFilter Field:=10, Criteria1:=Target.Value 'filte le tableau par rapport au secteur
nl = o.Range("A1:A" & o.Range("A65536").End(xlUp).Row).SpecialCells(xlVisible).Count
o.Range("A2").AutoFilter 'supprime le filtre
test = False 'redéfinit la variable test

Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Su

Merci et bon dimanches
 

Staple1600

XLDnaute Barbatruc
Re : Erreur sur code VBA - Décalage non voulu

Bonjour à tous

Antho35
Rebelote:Je ne vois pas dans ton code de: Dim plage As String
Pour savoir si ta syntaxe est bonne, essaies cette macro de test
Code:
Sub test()
Dim debdemo As Range
Dim plage As String
Set debdemo = Range("A30")
If debdemo.Row > 7 Then
plage = "5:" & debdemo.Row - 3
MsgBox Rows(plage).Address
End If
End Sub
Chez moi c'est bon , donc ensuite adapte en conséquence dans ton code initial.Comme ceci théoriquement
Code:
If debdemo.Row > 7 Then 
plage = "5:" & debdemo.Row - 3
Rows(plage).Delete Shift:=xlUp
End If
EDITION: Tu pourrais simplifier en écrivant ton code comme ceci (le résultat obtenu est le même)
Code:
Sub testII()
Dim debdemo As Range
Dim plage As String
Set debdemo = Range("A30")
If debdemo.Row > 7 Then
MsgBox Rows(5).Resize(debdemo.Row - 7).Address
End If
End Sub
et juste en attendant que mon thé refroidisse, une variante tout en un pour voir en une seule fois que le résultat est identique avec les deux syntaxes.
Code:
Sub testIII()
Dim debdemo As Range, plage$, tes1$, test2$
Set debdemo = Range("A30")
If debdemo.Row > 7 Then
'syntaxe UN
plage = "5:" & debdemo.Row - 3
test1 = Rows(plage).Address
'syntaxe DEUX
test2 = Rows(5).Resize(debdemo.Row - 7).Address
End If
MsgBox "SYNTAXE UN: " & vbTab & test1 & Chr(13) & "SYNTAXE DEUX: " & vbTab & test2
End Sub
 
Dernière édition:

Antho35

XLDnaute Occasionnel
Re : Erreur sur code VBA - Décalage non voulu

Re

Merci

Et ce dernier code je le place à quel endroit, par rapport à mon code du dernier classeur.

Et dire que je dois faire pareil avec les 3 autres onglets

Je ne serai jamais prêt pour jeudi.
 

Staple1600

XLDnaute Barbatruc
Re : Erreur sur code VBA - Décalage non voulu

Re


Il te suffit de faire la modif des lignes en rouge avec la bonne syntaxe
(comme je préfère la mienne, je mets la mienne)
Avec ces modifs cela fonctionne ou pas ?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim deddemo As Range, derl&, nl&, dl& 'déclare la variable dl (Dernière Ligne)
Dim o As Object 'déclare la variable o (Onglet)
Dim pl As Range 'déclare la variable pl (PLage)

If test = True Then Exit Sub 'si test est "vrai", sort de la procédure
If Target.Address <> "$K$2" Then Exit Sub 'si le chamgement a lieu ailleurs qu'en J2, sort de la procédure

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
test = True 'définit la variable test

'efface les éventuelles anciennes données
If Range("A7") <> "DEMOGRAPHIE" Then
'efface les éventuelles anciennes données
derl = Range("A" & Rows.Count).End(xlUp).Row
Set debdemo = Range("A1:H" & derl).Find("DEMOGRAPHIE", LookIn:=xlValues)
If debdemo.Row > 7 Then 
Rows(5).Resize(debdemo.Row -7).Delete Shift:=xlUp
End If

Set o = Sheets("Bases Communes") 'définit l'onglet o
dl = o.Range("A" & Rows.Count).End(xlUp).Row

Set pl = o.Range("A2:H" & dl) 'définit la plage pl

dl = o.Range("A" & Rows.Count).End(xlUp).Row
Rows(6).Resize(nl - 1).Insert
Set pl = o.Range("A2:H" & dl) 'définit la plage pl
o.Range("A2").AutoFilter Field:=10, Criteria1:=Target.Value 'filte le tableau par rapport au secteur
nl = o.Range("A1:A" & o.Range("A65536").End(xlUp).Row).SpecialCells(xlVi sible).Count
o.Range("A2").AutoFilter 'supprime le filtre
test = False 'redéfinit la variable test

Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub
 

Staple1600

XLDnaute Barbatruc
Re : Erreur sur code VBA - Décalage non voulu

Re

Antho35
Je viens d'ouvrir ta PJ
(un peu trop volumineuse à mon goût)
Et là , surprises :rolleyes:
1) quid de ceci?
=RECHERCHEV(A5;'C:\Users\AN\Documents\En Cours - Coordination\[Bases de Travail_Sectorisation_Tlt53.xlsm]Bases Population'!$I$9:$L$269;4;FAUX)
2) Le code VBA de ton message #17 n'est même pas dans ta PJ!!
3) Je ferme donc ta PJ et m'échappe de ce fil pour le moment ;)
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Erreur sur code VBA - Décalage non voulu

Re

Et comme ceci?
Il n'en demeure pas moins que le code VBA de ta pJ n'est pas celui qui te pose problème dans ton message #17
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
        Dim deddemo As Range, derl&, nl&, dl& 'déclare la variable dl (Dernière Ligne)
        Dim o As Object 'déclare la variable o (Onglet)
        Dim pl As Range 'déclare la variable pl (PLage)

        If test = True Then Exit Sub 'si test est "vrai", sort de la procédure
        If Target.Address <> "$K$2" Then Exit Sub 'si le chamgement a lieu ailleurs qu'en J2, sort de la procédure

        Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
        test = True 'définit la variable test

        'efface les éventuelles anciennes données
        If Range("A7") <> "DEMOGRAPHIE" Then
        'efface les éventuelles anciennes données
        derl = Range("A" & Rows.Count).End(xlUp).Row
        Set debdemo = Range("A1:H" & derl).Find("DEMOGRAPHIE", LookIn:=xlValues)
        If debdemo.Row > 7 Then
        Rows(5).Resize(debdemo.Row -7).Delete Shift:=xlUp
        End If
        End If

        Set o = Sheets("Bases Communes") 'définit l'onglet o
        dl = o.Range("A" & Rows.Count).End(xlUp).Row

        Set pl = o.Range("A2:H" & dl) 'définit la plage pl

        dl = o.Range("A" & Rows.Count).End(xlUp).Row
        Rows(6).Resize(nl - 1).Insert
        Set pl = o.Range("A2:H" & dl) 'définit la plage pl
        o.Range("A2").AutoFilter Field:=10, Criteria1:=Target.Value 'filte le tableau par rapport au secteur
        nl = o.Range("A1:A" & o.Range("A65536").End(xlUp).Row).SpecialCells(xlVi sible).Count
        o.Range("A2").AutoFilter 'supprime le filtre
        test = False 'redéfinit la variable test

        Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
        End Sub

POUR INFOS: Voici le code présent dans ta PJ. On est bien d'accord que ce n'est pas le même que dans le message #17
Private Sub Worksheet_Change(ByVal Target As Range)
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim nl As Integer 'décalre la variable nl

If test = True Then Exit Sub 'si test est "vrai", sort de la procédure

If Target.Address <> "$K$2" Then Exit Sub 'si le chamgement a lieu ailleurs qu'en J2, sort de la procédure

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
test = True 'définit la variable test

'efface les éventuelles anciennes données
If Range("A5") <> "" Then Range("C5").CurrentRegion.Resize(Range("C5").CurrentRegion.Rows.Count + 1).EntireRow.Delete
Set o = Sheets("Bases Communes") 'définit l'onglet o
dl = o.Range("A" & Rows.Count).End(xlUp).Row

Set pl = o.Range("A4:H" & dl) 'définit la plage pl
o.Range("A4").AutoFilter Field:=9, Criteria1:=Target.Value 'filte le tableau par rapport au secteur
nl = o.Range("A1:A" & o.Range("A65536").End(xlUp).Row).SpecialCells(xlVisible).Count
Rows(4).Resize(nl).Insert
pl.SpecialCells(xlCellTypeVisible).Copy Range("A5") 'copie le tableau filtrée
o.Range("A4").AutoFilter 'supprime le filtre
test = False 'redéfinit la variable test

Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub
 
Dernière édition:

Antho35

XLDnaute Occasionnel
Re : Erreur sur code VBA - Décalage non voulu

Totalement d'accord avec toi,

mais il ne marche pas non plus, le but est également de "récupérer' les lignes A1 à A3 de l'onglet Bases Communes.

Il faudra ensuite faire la même choses avec les autres onglets.

Excuse moi, il y a eu confusion entre les deux code.
 

Staple1600

XLDnaute Barbatruc
Re : Erreur sur code VBA - Décalage non voulu

Re


Antho35
Faudrait songer à changer de lunettes ;)
Ou alors essaie d'être plus attentif

Ci dessous une version modifiée juste pour savoir si le filtre se fait bien.
J'ai testé il se fait bien.
Maintenant regardes les changements effectués, notamment au niveau des adresses de cellules.
Tu vois les différences avec ton code d'origine ?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim deddemo As Range, derl&, nl&, dl& 'déclare la variable dl (Dernière Ligne)
Dim o As Object 'déclare la variable o (Onglet)
Dim pl As Range 'déclare la variable pl (PLage)

If test = True Then Exit Sub 'si test est "vrai", sort de la procédure
If Target.Address <> "$K$2" Then Exit Sub 'si le chamgement a lieu ailleurs qu'en J2, sort de la procédure

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
test = True 'définit la variable test

Set o = Sheets("Bases Communes") 'définit l'onglet o
'dl = o.Range("A" & Rows.Count).End(xlUp).Row
'Set pl = o.Range("A4:H" & dl) 'définit la plage pl
dl = o.Range("A" & Rows.Count).End(xlUp).Row
Set pl = o.Range("A4:H" & dl) 'définit la plage pl
o.Range("A4").AutoFilter Field:=9, Criteria1:=Sheets("Fiche Secteur").[K2] 'filte le tableau par rapport au secteur
nl = o.Range("A1:A" & o.Range("A65536").End(xlUp).Row).SpecialCells(xlVisible).Count
MsgBox nl
'Rows(6).Resize(nl - 1).Insert
'o.Range("A4").AutoFilter 'supprime le filtre
test = False 'redéfinit la variable test
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Erreur sur code VBA - Décalage non voulu

Re

Antho35
J'ai testé sur ton fichier joint et je n'ai pas d'erreur avec cette version
Le MsgBox s'affiche bien en pour 1 me donne: 15
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim deddemo As Range, derl&, nl&, dl& 'déclare la variable dl (Dernière Ligne)
Dim o As Object 'déclare la variable o (Onglet)
Dim pl As Range 'déclare la variable pl (PLage)

If test = True Then Exit Sub 'si test est "vrai", sort de la procédure
If Target.Address <> "$K$2" Then Exit Sub 'si le chamgement a lieu ailleurs qu'en J2, sort de la procédure

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
test = True 'définit la variable test

Set o = Sheets("Bases Communes") 'définit l'onglet o
'dl = o.Range("A" & Rows.Count).End(xlUp).Row
'Set pl = o.Range("A4:H" & dl) 'définit la plage pl
dl = o.Range("A" & Rows.Count).End(xlUp).Row
Set pl = o.Range("A4:H" & dl) 'définit la plage pl
o.Range("A4").AutoFilter Field:=9, Criteria1:=Sheets("Fiche Secteur").[K2] 'filte le tableau par rapport au secteur
nl = o.Range("A1:A" & o.Range("A65536").End(xlUp).Row).SpecialCells(xlVisible).Count
MsgBox nl
'Rows(6).Resize(nl - 1).Insert
'o.Range("A4").AutoFilter 'supprime le filtre
test = False 'redéfinit la variable test
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 721
Messages
2 081 928
Membres
101 842
dernier inscrit
seb0390