Macro VBA pour transférer des données d'une page Excel à une autre

J

Jeff

Guest
Bonjour,

Mon problème est le suivant: j'ai sur une page excel un tableau classique, et la dernière colonne (disons colonne N) est un champ de sélection: je peux le renseigner ou non à "OK". Je voudrais créer une macro qui, sur le simple appui d'un bouton, me transfère toutes les lignes en "OK" sur une seconde page du même classeur. Chaque appui de ce bouton doit préalablement effacer le contenu de la page cible avant de copier les données.

Etant débutant en VBA, je n'ai que des notions de programmation, et toute aide serait la bienvenue.

Merci d'avance!

Jeff.
 
R

Robert

Guest
Bonsoir Jeff, bonsoir le forum,

Adapte la macro ci-dessous et applique-la à ton bouton :

Sub Macro1()
'déclaration des variables
Dim plage As Range
Dim cel As Range
Dim ici As Range
'définit la variable plage (j'ai choisis la colonne A mais il
'faut que tu prennes une des colonnes dont la donnée est toujours éditée"
Set plage = Sheets("Feuil1").Range("A1:A" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)

'définit la variable ici (A1 de l'onglet "Feuil2")
Set ici = Sheets("Feuil2").Range("A1")

'efface toutes les données de l'onglet "Feuil2"
Sheets("Feuil2").Range("A1").CurrentRegion.Clear 'ou ClearContents pour garder les formats


'boucle sur toutes le cellules de la "plage décallée de 13" (Colonne N)
For Each cel In plage.Offset(0, 13)
'condition : si la cellule (colonne N) = "OK"
If cel.Value = "OK" Then
'copie la ligne entière et la colle dans la variable ici
cel.EntireRow.Copy Destination:=ici
Set ici = ici.Offset(1, 0) 'redéfinit la variable ici
End If 'fin condition
Next cel 'prochaine cellule de la colonne N
End Sub



À plus,

Robert
 
J

Jeff

Guest
C'est avec beaucoup de respect que je vous remercie pour cette aide.

Néanmoins j'ai un message d'erreur lors de l'utilisation:
" Erreur d'exécution 9, L'indice n'appartient pas à la sélection "
Erreur que je ne parviens pas à résoudre.

Avez-vous des pistes?

Merci encore,

Jeff
 
J

Jeff

Guest
Bonjour,

Je n'ai plus le problème d'erreur d'exécution 9.
J'ai également adapté le code afin de n'extraire vers la feuille de destination "feuil2" que trois colonnes du tableau initial, mais mon manque d'expérience VBA implique je pense une certaine lourdeur:

Voici le code, y a-t-il moyen de simplifier tout ça?


Sub test()


Dim i As Integer
Dim k As Integer
Dim plage As Range
Dim cel As Range
Dim ici As Range
Dim ici2 As Range
Dim ici3 As Range

k = 0
i = Sheets("Feuil1").Range("A65536").End(xlUp).Row
Set plage = Sheets("Feuil1").Range("A1:A" & i)
Set ici = Sheets("Feuil2").Range("A1")
Set ici2 = Sheets("Feuil2").Range("B1")
Set ici3 = Sheets("Feuil2").Range("C1")

Sheets("feuil2").Range("a1").CurrentRegion.Clear

For Each cel In plage.Offset(0, 13)
k = k + 1
If cel.Value = "ok" Then
Range("E" & k).Copy Destination:=ici
Range("F" & k).Copy Destination:=ici2
Range("K" & k).Copy Destination:=ici3
Set ici = ici.Offset(1, 0)
Set ici2 = ici.Offset(0, 1)
Set ici3 = ici.Offset(0, 2)
End If
Next cel

MsgBox ("Done")

End Sub


Si vous avez des idées pour alléger tout ça...
Merci beaucoup!

Jeff
 
@

@+Thierry

Guest
Bonjour Jeff, Robert, le Forum

Voici une Version "Light" :

Option Explicit

Sub ReportPlage()
Dim TabPlageSource As Variant
Dim i As Integer, L As Integer
Dim C As Byte, Ctab As Byte


  With Sheets("Feuil1")
    TabPlageSource = .Range("A2:N" & .Range("A65536").End(xlUp).Row)
  End With

Sheets("feuil2").Range("a1").CurrentRegion.Clear
L = 1

  For i = 1 To UBound(TabPlageSource)
       If UCase(TabPlageSource(i, 14)) = "OK" Then
           For C = 1 To 3
               Ctab = IIf(C = 3, 11, C + 4)
               Sheets("Feuil2").Cells(L, C) = TabPlageSource(i, Ctab)
           Next
       L = L + 1
       End If
  Next

MsgBox "Done"

End Sub


Et maintenant bien qu'ayant plus de lignes de codes, voici une version "Ultra Light", puisqu'on fait tout par Dynamic Array et que l'on écrit sur la feuille en une seule fois en fin de traitement. (Plus rapide)

Sub ReportPlageByArray()
Dim TabPlageSource As Variant
Dim TabPlageCible() As String
Dim TabCibleTmp() As String
Dim i As Integer, L As Integer, x As Integer
Dim C As Byte, Ctab As Byte


  With Sheets("Feuil1")
    TabPlageSource = .Range("A2:N" & .Range("A65536").End(xlUp).Row)
  End With

Sheets("feuil2").Range("a1").CurrentRegion.Clear
L = 1

  For i = 1 To UBound(TabPlageSource)
      If UCase(TabPlageSource(i, 14)) = "OK" Then
          ReDim Preserve TabPlageCible(3, x)
              For C = 0 To 2
                   Ctab = IIf(C = 2, 11, C + 5)
                   TabPlageCible(C, x) = TabPlageSource(i, Ctab)
              Next
      x = x + 1
      End If
  Next

  ReDim TabCibleTmp(UBound(TabPlageCible, 2), 3)
  For L = 0 To UBound(TabPlageCible, 2)
      For C = 0 To 2
          TabCibleTmp(L, C) = TabPlageCible(C, L)
      Next
  Next

Sheets("feuil2").Range("A1:C" & L) = TabCibleTmp()


MsgBox "Done"

End Sub


Bon Appétit
@+Thierry
 
R

Robert

Guest
Re à tous,

je viens à peine de comprendre la première macro...

Ctab = IIf(C = 3, 11, C + 4)

C'est à se la prendre, se la couper et se la mettre derrière l'oreille pour la fumer plus tard, non !!!

J'ose à peine attaquer la seconde....

À plus,

Robert
 
@

@+Thierry

Guest
Re Bonjour Robert, Jeff, le Forum

Tout d'abord il restait un résidu inutile dans la seconde macro (L = 1 est Inutile dans "ReportPlageByArray")

Pour ce qui est du IIf, en fait c'est assez simple, notre ami Jeff veut transposer la Colonne "E", la Colonne "F" et la Colonne "K".

Afin de pouvoir passer tout ceci dans une seule et même boucle je me base sur le C (1 to 3) pour la feuille de réception (Colonne A, B, C, soit 1, 2,3), et je me décale mon Ctab dessus...(Pour mon Tableau en colonne E, F et K)

En Clair :

Ctab = 11 (Soit Colonne "K") Si C = 3

Ctab = C + 4 (Soit Colonne "E") si C = 1
ou bien
Ctab = C + 4 (Soit Colonne "F") si C = 2...

Tout ceci en une ligne grace au IIf...

Toto = IIf(Toto = 0, "Toto est Nul", "Toto est Bon")
Soit en Syntax :IIf(expression, truepart, falsepart)

C'est STéphane qui m'avait montré ce coup là il y a longtemps sur ce Forum, depuis je trouve çà génial.

Le principe sera le même en second code, mais on est en base Zéro pour l'Array, donc décalage, c'est tout.

Bon Aprèm et heureux que ça vous plaise.
@+Thierry
 

Discussions similaires

Statistiques des forums

Discussions
311 730
Messages
2 081 978
Membres
101 854
dernier inscrit
micmag26