Macro copie de certaines informations d'un tableau d'une feuille sur une autre

[martinlef]

Bonjour à tous,

Etant débutant en vba, je m'arrache les cheveux depuis quelques jours sur une petite macro...

J'ai un tableau dans une feuille dont l'une des colonnes contient une information "oui"/"non". Je voudrais sélectionner, pour toutes les lignes pour lesquelles il y a "oui" dans cette colonne certaines cellules non contigües (pas la ligne entière, donc) et les coller dans une autre feuille. J'espère être assez clair...

De plus, il faudrait que les cellules soient collées dans la deuxième feuille à partir de la ligne 15 pour laisser la place pour une en-tête...

Merci pour votre aide !

Voici le code que j'ai actuellement:

Sub CreationOnglets()

' COPIE DES LIGNES DESIREES DANS LES FEUILLES DE CALCUL DEDIEES

Dim Rw As Range
Dim Ligne As Long

' Sélectionne l'ensemble des données (utile pour qu'Excel ne "réfléchisse" pas sur les 65000 lignes)

Sheets("Inventaire des risques").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select

' Boucle qui va passer sur chaque ligne de la sélection afin de déterminer si des lignes contiennent le flag voulu
' puis copie dans une deuxième feuille de calcul

For Each Rw In Selection.Rows

Ligne = Rw.Row

If Rw.Cells(1, 20).Value = "oui" Then
Rw.Range("B11,N1,P1,Q1,R1,S1").Copy Destination:=Worksheets("Sheet2").Cells(Ligne, 1).EntireRow
End If

Next Rw


' Supression des lignes vierges dans les feuilles de calcul récemment constituées

Sheets("Sheet2").Activate

With ActiveSheet.UsedRange
derLi = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For r = derLi To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

' Pop-up d'avertissement de fin de macro.

MsgBox "Planning annuel actualisé"

End Sub

 

[martinlef]

Re : Macro copie de certaines informations d'un tableau d'une feuille sur une autre

J'ai oublié de joindre le fichier ce serait peut être plus facile pour vous... Merci encore !

 

[Gorfael]

Re : Macro copie de certaines informations d'un tableau d'une feuille sur une autre

Salut martinlef et le forum
Une proposition

Sub test()
'déclaration =======================================
Dim F_1 As Worksheet
Dim F_2 As Worksheet
Dim X As Long
'MEI ===============================================
Set F_1 = Sheets("Inventaire des risques")
Set F_2 = Sheets("Sheet2")
'Traitement ========================================
'Copiage -------------------------------------------
F_1.AutoFilterMode = False
Range(F_1.[A13], F_1.Range("T" & F_1.Rows.Count).End(xlUp)).AutoFilter Field:=20, Criteria1:="oui"
Range(F_1.[A14], F_1.Range("T" & F_1.Rows.Count).End(xlUp)).Copy
'Collage -------------------------------------------
F_2.[A15].PasteSpecial (xlPasteValues)
'Suppression des valeurs inutiles ------------------
X = F_2.Range("A1").SpecialCells(xlCellTypeLastCell).Row
Union(F_2.Range("A15:A" & X), F_2.Range("C15:C" & X), F_2.Range("E15:M" & X), _
      F_2.Range("O15:O" & X), F_2.Range("T15:T" & X)).Delete Shift:=xlShiftToLeft
End Sub

A+

 

[vbacrumble]

Re : Macro copie de certaines informations d'un tableau d'une feuille sur une autre

Bonsoir tous


Une autre proposition

Sub Macro1()
' Macro1 Macro
' Macro enregistrée le 24/05/2009 par VBACrumble
Dim i&, r As Range
For i = 14 To 17
If Cells(i, "T") = "oui" Then
Set r = Range(Cells(i, "A"), Cells(i, "T")).SpecialCells(xlCellTypeConstants, 3)
r.Copy Sheets(2).[A65536].End(xlUp).Offset(1)
End If
Next
End Sub

 

[Gorfael]

Re : Macro copie de certaines informations d'un tableau d'une feuille sur une autre

Salut vbacrumble et le forum
Désolé d'émettre une critique, mais .Copy n'admet pas l'Offset (au moins jusqu'à la version 2003). (Mais je n'ai pas cette syntaxe d'offset).
Essaie et après remplace
r.Copy Sheets(2).[A65536].End(xlUp).Offset(1)
par
r.Copy Sheets(2).[A65536].End(xlUp) (2)
Normalement ça devrait être moins pire.
A+

 

[vbacrumble]

Re : Macro copie de certaines informations d'un tableau d'une feuille sur une autre

Re

Gorfael
Merci pour l'info

Mais mon Excel 2000 n'a pas bronché avec mon code initial lors de mes tests


D'où ma proposition

Une version qui ne copie que les valeurs seules

Sub Macro1vs()
' Macro1 Macro
' Macro enregistrée le 24/05/2009 par VBACrumble
Dim i&, r As Range
Application.ScreenUpdating = False
For i = 14 To 17
If Cells(i, "T") = "oui" Then
Set r = Range(Cells(i, "A"), Cells(i, "T")).SpecialCells(xlCellTypeConstants, 3)
r.Copy
Sheets(2).[A65536].End(-4162)(2).PasteSpecial -4163
Application.CutCopyMode = False
End If
Next
Application.ScreenUpdating = True
End Sub

 

[martinlef]

Re : Macro copie de certaines informations d'un tableau d'une feuille sur une autre

Merci beaucoup! Ca semble marcher parfaitement.