Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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:

Staple1600

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

Bonjour à tous


J'ai suivi mon idée de boucle
Cela fonctionne si je teste avec le secteur 1
Ensuite cela bug
Et pourtant le moment, je ne trouve où je mer-e
Si quelques membres du forum passant dans ce fil pouvait éclairer ma lanterne
(Apparement c'est la copie de cellules fusionnées qui coincent)
Antho35: Tu peux aussi de ton côte chercher ce que je n'ai pas su voir
Code:
Private Sub worksheet_Change(ByVal target As Range)
'Déclaration des variables
Dim pl As Range, derl&, nl&, dl&, i&, KK&
Dim arFeuilles
arFeuilles = Array("Bases Communes", "Bases Donnée Démographique", "Bases Résultat 2012")
If target.Address <> "$K$2" Then Exit Sub
Application.ScreenUpdating = False
Range("A5:H5").Resize(1000).Clear
For i = 0 To 2
With Sheets(arFeuilles(i))
    dl = .Range("A" & .Rows.Count).End(xlUp).Row
    Set pl = .Range("A1:H" & dl)
    .Range("A3").AutoFilter field:=10, Criteria1:=Me.[K2]   'Filtre le tableau par rapport au secteur
    KK = Me.Range("A" & Rows.Count).End(xlUp).Row
    pl.SpecialCells(12).Copy Me.Range("A" & KK).Offset(3)  'Copie le tableau filtré
    .Range("A3").AutoFilter  'suprime le filtre
    End With
Next i
Application.ScreenUpdating = True
End sub
PS: Pour le moment, je n'ai mis que trois feuilles dans l'array.
(Donc compléter si besoin)
 

Antho35

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

Bonjour,

Pour ce code cela nécessite que mes 4 tableaux est la même tête (les éléménts à remonté de tel colonne à tel colonne, le numéro de secteur à telle endroit) ???

Si c'est cela aucun probléme (juste à faire des modification dans ces tableaux) car actuellement par exemple le numéro de secteur n'est pas spécialement au même endroit.

Je vais tetser cela dans le week end.

Je reviens vers toi et le forum trés vite.
 

Discussions similaires

Réponses
7
Affichages
686
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…