Discussion :

[Lufia]

Bonjour!

J'ai un code qui transfert des données d'un fichier à un autre. En fait, il regarde si une cellule répond à un certain critère. Si oui, il coupe la ligne et l'envoie dans l'autre fichier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub Copierlignes()
  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
  Dim WkFeuille As Workbook
  Dim WkDatabase As Workbook
 
 Set WkFeuille = ThisWorkbook
 Set WkDatabase = Workbooks.Open(Filename:= _
   "G:\G-All-Jl-Plt\Ingénierie\Feuilles de temps\DATABASE HEURES CONTRACTEUR 2009 Test Macros.xls" _
   , UpdateLinks:=0)
 
  WkDatabase.Sheets("Database_Sommaire").Activate ' feuille de destination
  ActiveSheet.Unprotect ("954feuillesING")
  Col = "O"                 ' colonne de la donnée non vide à tester
  NumLig = 0
  WkFeuille.Activate
  With Sheets("Database")     ' feuille source
    NbrLig = .Cells(65536, Col).End(xlUp).Row
    For Lig = 1 To NbrLig
      If .Cells(Lig, Col).Value = "1" Then
          .Cells(Lig, Col).EntireRow.Cut
          NumLig = NumLig + 1
          Cells(NumLig, 1).Select
          WkDatabase.Sheets("Database_Sommaire").Activate
          Rows(WkDatabase.Sheets("Database_Sommaire").UsedRange.Rows.Count + 1).Select
          ActiveSheet.Paste
          WkFeuille.Activate
       End If
    Next
  End With
 
Application.CutCopyMode = False
WkDatabase.Sheets("Database_Sommaire").Protect "954feuillesING", DrawingObjects:=True, Contents:=True, Scenarios:=True
WkDatabase.Close savechanges:=True
 
WkFeuille.Sheets("Database").Activate
 
End Sub

J'ai un problème qui est intermitant. Je vous explique la situation:
J'ai 10 lignes qui renvoient la valeur vrai à ma condition (il est inscrit 1 dans la colonne O)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
If .Cells(Lig, Col).Value = "1" Then

Normalement lorsque j'exécute ma macro, il transfert mes 10 lignes dans mon autre fichier. Toutefois, il y a certaines fois (et c'est là mon problème, je n'arrive pas à comprendre pourquoi) où il ne transfert que la première ligne et passe directement à "End With". Si j'exécute ma macro plusieurs fois, éventuellement elle fini par s'exécuter correctement.

Avez-vous une idée de ce qui se passe? Je suis vraiment perplexe!
Merci à l'avance!!

[ucfoutu]

Bonjour,


en coupant (cut) et en descendant, tu te fais des croche-pieds avec les n°s de ligne...

Commence ta boucle For par la dernière ligne et remonte vers le haut (step -1) ...

[Lufia]

Bonjour!

Merci pour ta réponse, c'est tout à fait logique!
Je ne suis pas encore très habituée en VBA alors je voudrais valider mon code.
Ça semble fonctionner, mais pour éviter des problèmes éventuels

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
For Lig = NbrLig To 1 Step -1
      If .Cells(Lig, Col).Value = "1" Then
          .Cells(Lig, Col).EntireRow.Cut
          NumLig = NumLig + 1
          Cells(NumLig, 1).Select
          WkDatabase.Sheets("Database_Sommaire").Activate
          Rows(WkDatabase.Sheets("Database_Sommaire").UsedRange.Rows.Count + 1).Select
          ActiveSheet.Paste
          WkFeuille.Activate
       End If
    Next

Merci!

[ucfoutu]

Une seule chose m'interpelle :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
NumLig = NumLig + 1
          Cells(NumLig, 1).Select

Qu'en fais-tu et pourquoi ?

[Lufia]

En effet, cette ligne ne semble pas nécessaire! J'ai repris cette macro d'un fichier créé par un autre utilisateur...

Parcontre, mon problème persiste même en utilisant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Lig = NbrLig To 1 Step -1

Il continue de ne transferer que la première ligne... Je n'y comprend rien

[Lufia]

Bonjour!

Voila mon code final qui fonctionne très bien!!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub Copierlignes()
  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
  Dim WkFeuille As Workbook
  Dim WkDatabase As Workbook
  Dim lFin As Long
Set WkFeuille = ThisWorkbook
 Set WkDatabase = Workbooks.Open(Filename:= _
   "G:\G-All-Jl-Plt\Ingénierie\Feuilles de temps\DATABASE HEURES CONTRACTEUR 2009 Test Macros.xls" _
   , UpdateLinks:=0)
 
  WkDatabase.Sheets("Database_Sommaire").Activate ' feuille de destination
  ActiveSheet.Unprotect ("954feuillesING")
  Col = "O"                 ' colonne de la donnée non vide à tester
  NumLig = 0
  WkFeuille.Activate
  With Sheets("Database")     ' feuille source
    For Lig = 65536 To 1 Step -1
      If .Cells(Lig, Col).Value = "1" Then
          .Cells(Lig, Col).EntireRow.Cut
          WkDatabase.Sheets("Database_Sommaire").Activate
          Rows(WkDatabase.Sheets("Database_Sommaire").UsedRange.Rows.Count + 1).Select
          ActiveSheet.Paste
          WkFeuille.Activate
       End If
    Next
  End With
 
Application.CutCopyMode = False
WkDatabase.Sheets("Database_Sommaire").Protect "954feuillesING", DrawingObjects:=True, Contents:=True, Scenarios:=True
WkDatabase.Close savechanges:=True
 
End Sub

Merci pour l'aide!