XL 2013 regrouper plusieurs feuilles sans les formules

[renaud2530]

Bonsoir,

Ci-dessous une macro pêchée sur un forum qui permet de compiler les lignes de plusieurs feuilles dans un tableau recap. Quelle modification faut-il y apporter pour que celle-ci ne copie que les lignes qui contiennent une valeur? Pour l'instant, cela copie également les lignes qui contiennent des formules...
D'avance merci pour votre précieuse aide.

Cordialement,


Sub transfert()
Dim dlgR As Integer, dlgi As Integer
Dim i As Byte
With Sheets("RECAP")
dlgR = .Range("a" & Rows.Count).End(xlUp).Row
.Range("a2:x" & dlgR).ClearContents
End With
For i = 1 To Worksheets.Count
Select Case UCase(Sheets(i).Name)
Case Is = "RECAP"

Case Else
dlgR = Sheets("RECAP").Range("a" & Rows.Count).End(xlUp).Row
With Sheets(i)
dlgi = .Range("a" & Rows.Count).End(xlUp).Row
.Range("a2:x" & dlgi).Copy Sheets("RECAP").Range("a" & dlgR + 1)
End With
End Select
Next
End Sub


Renaud

 

[Calvus]

Bonsoir,

Ton code actuel copie toute la feuille, c'est donc normal que tu copies également les formules.
Il faudrait changer le code.

A+

 

[renaud2530]

Bonsoir,
Les feuilles sources se remplissent au fur et à mesure, ..., n'st-il pas possible de copier uniquement les cellules "visibles"?
Bàt,

 

[Calvus]

Re,

Je n'ai pas le fichier sous les yeux, je ne peux donc pas deviner...
Cette procédure

.Range("a2:x" & dlgi).Copy Sheets("RECAP").Range("a" & dlgR + 1)

copie toute la feuille.
Alors je ne sais pas ce qu'il s'affiche chez toi, mais moi je ne peux t'en dire plus sans fichier.

A+

 

[renaud2530]

chaque feuille est un tableau à remplir au fur et à mesure de l'année au format identique à chaque fois. Chaque tableau va de la ligne 2 à 100 (ligne1 = titres). Dans certaines colonnes, j'ai des formules de 2à 100. Je voudrais compiler uniquement les lignes dans lesquelles les conditions ont été remplies et ou un résultat s'affiche( peut importe à quelle place sur la ligne)

 

[Calvus]

Re,

Alors voici un code pour la copie sans les formules.
Je te laisse adapter.

Option Explicit
Sub Copie()
Dim i As Long, j As Integer, t(), t1
t = Range(Cells(1, 1), Cells(100, 100))
ReDim t1(1 To UBound(t), 1 To UBound(t))
For i = 2 To 100
For j = 2 To 100
If Not Cells(i, j).HasFormula Then
t1(i, j) = Cells(i, j)
End If
Next
Next
Range("A1").Resize(UBound(t1), UBound(t1)) = t1 'Choisir où on veut copier
End Sub