[vba] Copier/Coller une feuille/trie..

[lezabour]

Bonjour a tous,

j'ai une feuille comptable de 10.000 lignes. Sur cettes dernieres, des lignes peuvent etre remplie ou non un peu partout en fonction d'un numero (colonne F)
Bref, je veux faire une exploitation de mes resultats, dans un autre classeur excel.
Ce que je veux faire: j'aimerai copier les cellules remplis (dont le champ A est non vide) et les coller dans un classeur B dans une feuille Exploitation. Mais il faut que ce soit fais par "collage special", pour n'avoir que les valeurs et pas les macros, et pour que ce nouveau classeur soit totalement independant de l'autre.

Voici mon probleme: -Deja j'ai 10.000 lignes, donc faut eviter le parcours de chaque ligne...
Moi pour le moment je fais ca:
With Worksheets(NewFeuille)
.Range("A5:O10000").FormulaR1C1 = "='" & chemin & "[" & fichier & "]" & Feuille & "'!RC"
End With

Qui ne me convient pas car il ne copie pas les valeurs mais aussi les macros... De plus ca me met des 0 sur toutes les lignes "vides" de mon fichier de depart, donc je me retrouve avec une nouvelle feuille d'exploitation remplie de 0 et evidemment mes lignes

bref quelqu'un aurait une idée?
Merci

 

[Zon]

Salut,

On peut le faire pas tableaux VBA, colles ceci dans un module standard, à toi de rajouter la mise en forme dans le nouveau classeur si tu le désires.

Sub Princ()
Dim T, C As Workbook
 T = Worksheets(1).Range("A1:O10000").Value 'Plage à adpater
 T = SupprLigVides(T, 1) '1 puisque c'est sur la colonne A
 T = InverseTab(T)
 Set C = Workbooks.Add(xlWBATWorksheet)
   With C
    With .Worksheets(1)
      .[A5].Resize(UBound(T) + 1, UBound(T, 2) + 1) = T
    End With
   End With
End Sub

Function SupprLigVides(T, Col As Byte)
Dim I&, J&, K&, Temp
 ReDim Temp(UBound(T, 2) - 1, K)
 For I = LBound(T) To UBound(T)
&nbsp;&nbsp;&nbsp;If T(I, Col) <> "" Then
&nbsp;&nbsp;&nbsp;&nbsp;For J = LBound(T, 2) To UBound(T, 2)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Temp(J - 1, K) = T(I, J)
&nbsp;&nbsp;&nbsp;&nbsp;Next J
&nbsp;&nbsp;&nbsp;&nbsp;K = K + 1
&nbsp;&nbsp;&nbsp;&nbsp;ReDim Preserve Temp(UBound(T, 2) - 1, K)
&nbsp;&nbsp;&nbsp;End If
&nbsp; Next I
SupprLigVides = Temp
End Function

Function InverseTab(T, Optional Base As Byte = 0)
Dim Temp(), I&, J&
&nbsp;ReDim Temp(Base To UBound(T, 2), Base To UBound(T))
&nbsp;For I = LBound(T, 2) To UBound(T, 2)
&nbsp;&nbsp;&nbsp;For J = LBound(T) To UBound(T)
&nbsp;&nbsp;&nbsp;&nbsp;Temp(I, J) = T(J, I)
&nbsp;&nbsp;&nbsp;Next J
&nbsp;Next I
InverseTab = Temp
End Function

A+++

Lien supprimé