Copier des colonnes d'une base de données vers d'autres feuilles

[Litiou]

Bonjour,

Nouveaux sur ce forum et novice sur excel...

Je voudrai reproduire le code sur le lien à quelques détail prêt.
Je voudrai copier plusieurs colonne (avec mise à jour bien sur) vers une autre feuille.
Exemple:
Je voudrais copier les colonnes A, B et I sur une feuille
Et copier les colonnes G, K, et V vers une autre feuille.

Mais que tout se mettent a jour...
Y compris quand je rajoute ou supprime des lignes.

A l'identique du fichier excel sur le liens.
Je ne vois pas comment modifier le code en place.

https://www.excel-downloads.com/attachments/copie-de-problèmatique-xlsm.213990/

Merci d'avance pour vos explications

 

[Lone-wolf]

Bonjour Litiou, le Forum

Exemple à adapter à ton fichier. Mais il faut convertir le tableau en plage.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim derlig As Long

Application.ScreenUpdating = False
derlig = Range("a" & Rows.Count).End(xlUp).Row

If Not Intersect(Target, Columns("K:K")) Is Nothing  Then
With Feuil2
Range("a2:b" & derlig).Copy = .Range("a2")
Range("i2:i" & derlig).Copy = .Range("c2")
End With
End If

If Not Intersect(Target, Columns("W:W")) Is Nothing Then
With Feuil3
Range("g2:g" & derlig).Copy = .Range("a2")
Range("k2:k" & derlig).Copy = .Range("b2")
Range("v2:v" & derlig).Copy = .Range("c2")
End With
End If
End Sub

'POUR FILTRER LES COLONNES DE TON CHOIX
'A METTRE DANS UN MODULE
Option Explicit

Sub Filtrer_Col()
Dim derlig As Long, plage as range
With ActiveSheet
  derlig = .Range("a" & Rows.Count).End(xlUp).Row
  Set plage = .Range("a1:v" & derlig)
  plage.AutoFilter Field:=Activecell.Column, Criteria1:=Activecell.Value, Operator:=xlAnd
End With
End Sub

 

[Lone-wolf]

Re

Un autre façon de faire en passant par des tableaux. Utilise Tab du clavier, jusqu'à la colonne W.

Option Explicit
Dim derlig As Long, derlig2 As Long, i As Long, plage As Range, tablo(), tbl()

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Application.ScreenUpdating = False

  derlig2 = Range("a" & Rows.Count).End(xlUp).Row
  Set plage = Range("a1:v" & derlig2)
  plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=ActiveCell.Value, Operator:=xlAnd

Cancel = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  Application.ScreenUpdating = False
  derlig = Range("a" & Rows.Count).End(xlUp).Row

  tablo = Range("a2:i" & derlig)
  tbl = Range("g2:v" & derlig)

  On Error Resume Next

  derlig2 = Range("a" & Rows.Count).End(xlUp).Row
  Set plage = Range("a1:v" & derlig2)
  plage.AutoFilter

  If Not Intersect(Target, Columns("J:J")) Is Nothing Then
  Feuil2.Range("a2:c65536").ClearContents

  For i = 1 To UBound(tablo, 1)
  Feuil2.Cells(i + 1, "A") = tablo(i, 1)
  Feuil2.Cells(i + 1, "B") = tablo(i, 2)
  Feuil2.Cells(i + 1, "C") = tablo(i, 9)
  Next i
  End If


  If Not Intersect(Target, Columns("W:W")) Is Nothing Then
   Feuil3.Range("a2:c65536").ClearContents

  For i = 1 To UBound(tbl, 1)
  Feuil3.Cells(i + 1, "A") = tbl(i, 1)
  Feuil3.Cells(i + 1, "B") = tbl(i, 5)
  Feuil3.Cells(i + 1, "C") = tbl(i, 16)
  Next i
  End If

End Sub

En PJ le classeur exemple

 

[DoubleZero]

Bonjour, Litiou, Lne-wolf, le Forum,

Autre possibilité :

- supprimer le code de l'onglet "tableaugénéral" ;

- insérer le suivant dans le module de l'onglet "Feuil2" :

Option Explicit
Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    Sheets("tableaugénéral").Range("b:c,e:e").Copy Destination:=Range("a1")
    Application.ScreenUpdating = True
End Sub

A bientôt

 

[Lone-wolf]

Bonjour Ma chère DoubleZero

Le code que tu as mis n'est pas juste, c'est les colonnes qu'elle à mis dans le message qu'il faut prendre en considération.

 

[DoubleZero]

Re-bonjour,

... Le code que tu as mis n'est pas juste, c'est les colonnes qu'elle à mis dans le message qu'il faut prendre en considération.

Saperlippette, je n'ai tenu compte que de ceci (mentions insérées dans le fichier fourni).

En relisant la demande exposée en #1, je ne sais plus quelle orientation prendre.

A bientôt

 

[Si...]

Bonjour

En relisant la demande exposée en #1, je ne sais plus quelle orientation prendre.

Hé oui ÖÔ, quand on perd le Nord on a le Sud au … !

Les colonnes choisies (par titre) du tableau nommé T out, se copient dans l’autre le tableau nommé T in de l'autre onglet à l'activation de ce dernier.
Pour alléger le fichier, ce dernier est effacé lors de la désactivation de la feuille.

Bon week-end

 

[DoubleZero]

Re-bonjour, bonjour, Si,

...quand on perd le Nord...

Lundi, ma lettre au Papa Noël sera postée.

Oui, je sais... il me faudra attendre 296 longs jours avant de recevoir une magnifique

​

Bon week-end, itou, et à bientt

 

[Lone-wolf]

Re à toutes , Si...

Si..., toi aussi tu as perdu le nord et le Sudoku! Ce n'est pas le bon fichier!
Regarde qu'elles sont les colonnes du Post #1.

 

[Si...]

Bonjour

Lone, Sudoku… oups, je me suis trompé de grille : je croisais des mots.

Je crois n’avoir pas encore perdu la boussole (si gracieusement offerte par ÓÔ, merci ) .
Ma réponse, comme celles que je donne en général, est un exemple de ce que l’on peut faire. Après, chacun en dispose comme qu’il en veu.

Tu sais très bien que s’attacher à la forme plutôt qu’au fond revient à multiplier les propositions en tout genre et que la maîtrse de l'outil permet de faire du bon travail*.


* pour saluer une connaissance : « j'en connais qui utilisent la grosse Bertha pour se débarrasser d'un moustique »

 

[Litiou]

Bonjour,

Désolé de répondre tardivement mais merci beaucoup de vos réponses.
Je voudrais comprendre un peu car la je plane.

Qui pourrait m'expliquer ce code:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As Integer
Col = Target.Column
If Col = 2 Or Col = 3 Or Col = 5 Then
Me.Range("B:C,E:E").Copy Destination:=Sheets("Feuil2").Range("A1")
Application.CutCopyMode = False
End If
End Sub



Encore merci à tous.
Bonne journée.

 

[DoubleZero]

Bonjour à toutes et à tous,

... Qui pourrait m'expliquer ce code...

Quelques commentaires :

Option Explicit
' macro événementielle
Private Sub Worksheet_Change(ByVal Target As Range)
' variable déclarer
    Dim Col As Integer
    ' colonne = colonne de la cellule active
    Col = Target.Column
    ' conditions : si cellule modifiée en b, c ou e
    If Col = 2 Or Col = 3 Or Col = 5 Then
        ' colonnes b, c, e copier vers onglet nommé "Feuil2", en a1
        Me.Range("B:C,E:E").Copy Destination:=Sheets("Feuil2").Range("A1")
        ' inutile dans le cas présent
        Application.CutCopyMode = False
        ' fin des conditions
    End If
End Sub

Pour ce qui concerne la déclaration des variables, Cf. ici.

Bon courage et à bientôt