Extraire donnees le code fonctionne mais

Le 27/07/2018 à 14:19

Voila,mon code fonctionne pour extraire des donnees d une feuille activite vers une autre feuille BLN sauf que je ne trouve pas pourquoi mes donnees sont decalées de 2 rangs sur la colonne B

Je ne trouve pas le pourquoi du comment

Sub Copier_Déc()

Dim DerLig As Long

Dim Lig As Integer

For Lig = 14 To 100

DerLig = Range("B1").End(xlDown).Row + 1

'DerLig cela me sert plus loin dans mon code

'-----------------------------------------------------------------------

'banlin

If Feuil1.Cells(Lig, 25) = "BLN" Or Feuil1.Cells(Lig, 26) = "BLN" Then

Worksheets("BLN").Rows(2).Insert Shift:=xlDown

'colonne A

Worksheets("BLN").Cells(1, 1) = Worksheets("Activité").Cells(4, 7)

'Colonne B

Worksheets("BLN").Cells(2, 2) = Worksheets("Activité").Cells(Lig, 2)

'Colonne C

Worksheets("BLN").Cells(2, 3) = Worksheets("Activité").Cells(Lig, 3)

'Colonne D

Worksheets("BLN").Cells(2, 4) = Worksheets("Activité").Cells(Lig, 4)

'Colonne S

Worksheets("BLN").Cells(2, 5) = Worksheets("Activité").Cells(Lig, 40)

'Colonne X

Worksheets("BLN").Cells(2, 6) = Worksheets("Activité").Cells(Lig, 24)

End If

If Feuil1.Cells(Lig, 27) = "BLN" Or Feuil1.Cells(Lig, 28) = "BLN" Then

Worksheets("BLN").Rows(2).Insert Shift:=xlDown

'Colonne A

Worksheets("BLN").Cells(1, 1) = Worksheets("Activité").Cells(4, 7)

'Colonne B

Worksheets("BLN").Cells(2, 2) = Worksheets("Activité").Cells(Lig, 2)

'Colonne C

Worksheets("BLN").Cells(2, 3) = Worksheets("Activité").Cells(Lig, 3)

'Colonne D

Worksheets("BLN").Cells(2, 4) = Worksheets("Activité").Cells(Lig, 4)

'Colonne S

Worksheets("BLN").Cells(2, 5) = Worksheets("Activité").Cells(Lig, 41)

'Colonne X

Worksheets("BLN").Cells(2, 6) = Worksheets("Activité").Cells(Lig, 24)

End If

If Feuil1.Cells(Lig, 29) = "BLN" Then

Worksheets("BLN").Rows(2).Insert Shift:=xlDown

'Colonne A

Worksheets("BLN").Cells(1, 1) = Worksheets("Activité").Cells(4, 7)

'Colonne B

Worksheets("BLN").Cells(2, 2) = Worksheets("Activité").Cells(Lig, 2)

'Colonne C

Worksheets("BLN").Cells(2, 3) = Worksheets("Activité").Cells(Lig, 3)

'Colonne D

Worksheets("BLN").Cells(2, 4) = Worksheets("Activité").Cells(Lig, 4)

'Colonne S

Worksheets("BLN").Cells(2, 5) = Worksheets("Activité").Cells(Lig, 42)

'Colonne X

Worksheets("BLN").Cells(2, 6) = Worksheets("Activité").Cells(Lig, 24)

End If

If Feuil1.Cells(Lig, 30) = "BLN" Then

Worksheets("BLN").Rows(2).Insert Shift:=xlDown

'Colonne A

Worksheets("BLN").Cells(1, 1) = Worksheets("Activité").Cells(4, 7)

'Colonne B

Worksheets("BLN").Cells(2, 2) = Worksheets("Activité").Cells(Lig, 2)

'Colonne C

Worksheets("BLN").Cells(2, 3) = Worksheets("Activité").Cells(Lig, 3)

'Colonne D

Worksheets("BLN").Cells(2, 4) = Worksheets("Activité").Cells(Lig, 4)

'Colonne S

Worksheets("BLN").Cells(2, 5) = Worksheets("Activité").Cells(Lig, 43)

'Colonne X

Worksheets("BLN").Cells(2, 6) = Worksheets("Activité").Cells(Lig, 24)

End If

Le 27/07/2018 à 14:44

Bonjour,

Je ne comprends pas le décalage mentionné.

ric

Le 27/07/2018 à 15:14

Bonjour,

Peux-t-on avoir ton fichier ? Cela nous permettra aussi de simplifier un peu ton code.

Le 27/07/2018 à 15:42

Bonjour sat3367, le forum,

j'ai un peu réduit ton code VBA. 

Option Explicit

Dim ws As Worksheet, Lig As Long

Private Sub Job(col As Byte)
  With Worksheets("BLN")
    .Rows(2).Insert xlDown
    .[A1] = ws.[G4]
    .[B2] = ws.Cells(Lig, 2)
    .[C2] = ws.Cells(Lig, 3)
    .[D2] = ws.Cells(Lig, 4)
    .[E2] = ws.Cells(Lig, col)
    .[F2] = ws.Cells(Lig, 24)
  End With
End Sub

Sub Copier_Déc() 'banlin
  Dim DerLig As Long, Lig As Integer: Set ws = Worksheets("Activité")
  DerLig = Range("B1").End(xlDown).Row + 1: Application.ScreenUpdating = 0
  For Lig = 14 To DerLig
    With Feuil1
      If .Cells(Lig, 25) = "BLN" Or .Cells(Lig, 26) = "BLN" Then Job 40
      If .Cells(Lig, 27) = "BLN" Or .Cells(Lig, 28) = "BLN" Then Job 41
      If .Cells(Lig, 29) = "BLN" Then Job 42
      If .Cells(Lig, 30) = "BLN" Then Job 43
    End With
  Next Lig
End Sub

mais pour ton décalage, faut préciser ! tu as écrit : « mes données sont décalées de 2 rangs sur la colonne B »

* tu veux dire qu'en colonne B, tu as des résultats en ligne 20 et ça aurait dû être en ligne 18 ?

* tu veux dire que tes résultats sont en colonne B, et ça aurait dû être en colonne D ?

* tu veux dire autre chose ?

dhany

Le 30/07/2018 à 11:38

merci je vais tester ton code cet apres midi

Le 30/07/2018 à 14:12

hello

ce code ne fonctionne pas du moins n affiche pas de donnees en sheets BLN

Le 30/07/2018 à 14:17

salut,

pour t'aider davantage, il faudrait ton classeur (sans données confidentielles) ; pour cela, tu peux utiliser le bouton « Ajouter des fichiers » qui est situé juste sous la fenêtre d'édition de ton post.

dhany

Le 30/07/2018 à 14:33

ajout : n'oublie pas non plus de répondre aux questions que je t'ai posées à la fin de mon post du 27 juillet !

donc tout à la fin de ce post (clique sur le lien vert) : https://forum.excel-pratique.com/viewtopic.php?p=674008#p674008

dhany

Le 31/07/2018 à 09:05

repondu en mp tu as mes 2 fichiers

merci

Le 23/09/2018 à 19:06
screen

j'ai bien lu tes 2 mp, mais toi, bien que ta dernière visite soit du 17 septembre, tu n'as toujours pas lu mon mp du 25 août !

ce mp contient les 2 fichiers confidentiels que tu dois tester (si toutefois ça t'intéresse toujours).

dhany

Rechercher des sujets similaires à "extraire donnees code fonctionne"