Copier Ligne entière sauf les valeurs d'une colonne

aba2s

XLDnaute Junior
Bonjour la communauté,
Je viens vers vous pour solliciter votre aide. Je souhaite recopier une ligne ligne entière sauf les valeurs de la colonne A.
Je m'explique : J'ai une macro qui parcours les valeurs de la colonne A (feuille PivotTable). Si la valeur trouvé est égale à la valeur de la celle B2 (feuille Suivi), je veux que la macro me copie toute la ligne de la feuille (PivotTable) sauf les valeurs de la colonne A (IO name) dans la feuille Suivi en colonne B.
J'ai mis ce que je souhaite avoir dans la feuille suivi. Ma macro fonctionne mais pas je le veux.

Merci d'avance
VB:
Sub detailStats()
comptage = 5

campaign = Sheets("Suivi").Range("B2").Value

'Details consolidés par Insertion Order

ActiveWorkbook.Sheets("PivotTable").Activate
For Each ioName In Sheets("PivotTable").Range("A3:A" & Cells(Rows.Count, "A").End(xlUp).Row)
If ioName Like campaign Then
comptage = comptage + 1
Sheets("PivotTable").Rows(ioName.Row).Copy Destination:=Sheets("Suivi").Range("A" & comptage)
End If
Next ioName


ActiveWorkbook.Sheets("Suivi").Activate
End Sub
 

Pièces jointes

  • Data.xlsm
    44.4 KB · Affichages: 5

piga25

XLDnaute Barbatruc
Bonjour aba2s, le forum

Juste à effacer ce qu'il y a en A6

VB:
Sub detailStats()
comptage = 5

campaign = Sheets("Suivi").Range("B2").Value

'Details consolidés par Insertion Order

ActiveWorkbook.Sheets("PivotTable").Activate
For Each ioName In Sheets("PivotTable").Range("A3:A" & Cells(Rows.Count, "A").End(xlUp).Row)
If ioName Like campaign Then
comptage = comptage + 1
Sheets("PivotTable").Rows(ioName.Offset(, 1).Row).Copy Destination:=Sheets("Suivi").Range("A" & comptage)
End If
Next ioName
ActiveWorkbook.Sheets("Suivi").Activate
Range("A6").ClearContents
End Sub
 

Pièces jointes

  • aba2s.xlsm
    47.6 KB · Affichages: 5

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir @aba2s, @piga25,

Un essai sans suppression de colonne...

VB:
Sub detailStats()
Dim comptage As Long, campaign As String, xrow
  comptage = 5: campaign = Sheets("Suivi").Range("B2").Value
  With ActiveWorkbook.Sheets("PivotTable").Range("A3:A" & Cells(Rows.Count, "A").End(xlUp).Row).EntireRow
    For Each xrow In .Rows
      If xrow.Cells(1, 1) Like campaign Then
        comptage = comptage + 1
        xrow.Resize(, Columns.Count - 1).Offset(, 1).Copy Destination:=Sheets("Suivi").Range("b" & comptage)
      End If
    Next xrow
  End With
ActiveWorkbook.Sheets("Suivi").Activate
End Sub
 

Discussions similaires