VBA : Collage special

[t3tsuo]

Bonjour a tous, je souhaite via une macro coller une feuille vers une autre en ne prenant en compte que les lignes visibles.

Voici le code que j'ai fait :

Sub Envoie()

Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long

Sheets("N").Activate ' feuille de destination

Col = "A"
NumLig = 7
With Sheets("RS")
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig
If .Cells(Lig, Col).Value <> "" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Cells(NumLig, 1).Select
ActiveSheet.Paste
End If
Next
End With

End Sub

Donc ca ca marche, mais certaines lignes affichent #REF! (surement du fait que les lignes copiees sont en fait des fonctions).mais apres j'ai essaye plusieurs déclinaisons au niveau de

ActiveSheet.Paste

pour le passer en PasteSpecial, comme par exemple :

ActiveSheet.PasteSpecial xlPasteValues

mais rien n'a faire je ne parviens pas a mon resultat,

Excel m'affiche :

Run-time error '1004' PasteSpecial method of Worksheet class failed

Je voulais donc savoir comment faire pour que VBA me fasse un past special value?

EN vous remerciant d'avance pour vos conseils toujours avises,

Cordialement,

T3tsuo

PS : Excel 2003 version US

 

[batistuta]

Re : VBA : Collage special

bonjour les amis,
J'ai un problème qui ressemble au votre.
Ma macro sert a chercher un mot zffiché sur une cellule le long d'une ligne après chercher un code le long de la colonne sélectionnée.
On copie les lignes qui contiennent le code .
Sauf que le probleme est le meme j'ai des formules sur certaines lignes et j'arrive pas à changer ma macro.

Voila ma macro:


Sub recherche()

Dim F1 As Worksheet, F3 As Worksheet, col, n&, cel As Range, cel1 As Range
Set F1 = Sheets("Agences") 'feuille de données
Set F3 = Sheets("Affichage") 'feuille de restitution

F1.Cells.Copy F3.Cells 'pour copier les formats des colonnes, on peut supprimer ensuite
F3.Rows("2:65536").Clear
col = Application.Match([G5], F1.Rows(4), 0)
If IsError(col) Or [H7] = "" Then Exit Sub
n = 2

For Each cel In F1.Range(F1.Cells(2, col), F1.Cells(65536, col).End(xlUp))
If LCase(cel) Like "*" & LCase([H7]) & "*" Then
cel.MergeArea.EntireRow.Copy F3.Rows(n)
If Not cel.MergeCells Then
For Each cel1 In Intersect(F3.Rows(n), F3.UsedRange)
With cel1
If F1.Cells(cel.Row, .Column).MergeCells Then
.Value = F1.Cells(cel.Row, .Column).MergeArea(1)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.WrapText = True 'retour à la ligne
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End If
End With
Next
End If
n = n + cel.MergeArea.Count
End If
Next

F3.Activate 'facultatif


End Sub




Merci pour votre aide