VBA ventilation de données

Bonjour,

Un nouveau problème se présente à moi. Je cherche à ventiler les données d'une feuille sur d'autres feuilles. Le code fonctionne bien mais j'aimerai que le code ne me colle que les valeurs et non les formules. L'autre problème est qu'il n'arrive pas à copier les valeurs lorsqu'elles sont sous forme de tableau. Voici le code ci-dessous :

Dim j As Integer
Dim LastRow_SOURCE As Long
Dim LastRow As Long

Public Sub Ventilation()
Application.ScreenUpdating = False
'on part de la source
LastRow_SOURCE = Sheets("Source").Range("A" & Rows.Count).End(xlUp).Row
'on boucle dans la source
For k = 6 To LastRow_SOURCE
'boucle permettant de lire toutes les 12 feuilles du classeur
For j = 8 To 27
With Sheets(j)
If .Name <> "Source" Then
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'controle dans le cas ou la liste est vide
If LastRow > 5 Then .Range("a6:a" & LastRow).EntireRow.Delete
'ventiler les noms de la colonne 3 dans chaque feuille si celui-ci a le meme intitulé que la feuille
If .Name = Sheets("Source").Cells(k, 3).Value Then
Sheets("Source").Range("A" & k).EntireRow.Copy Destination:=.Cells(6, 1)

End If
End If
End With
Next j
Next k
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

merci d'avance

Bonjour,

Essaie ainsi :

If .Name = Sheets("Source").Cells(k, 3).Value Then
    WorkSheets("Source").Range("A" & k).EntireRow.Copy
    .Cells(6, 1).Paste xlPasteValuesAndNumberFormats
    Application.CutCopyMode=0
End If

Il me met un message d'erreur d'exécution 438 ; propriété ou méthode non gérée par cet objet

sur la ligne de code .Cells(6, 1).Paste xlPasteValuesAndNumberFormats

Re,

Oups !...

.Cells(6,1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

super ça fonctionne.

Mon autre problème est qu'il ne copie pas les données de mon tableau

si ma ligne à copier est sous forme de tableau il ne la copie pas

si elle n'est pas sous forme de tableau il la copie et me la colle au bon endroit

Merci :)

Re,

Joins un petit fichier pour une aide adaptée.

Cdlt.

Mon code est dans module, ventilation

Il doit copier les données de la feuille "Source" dans les autres feuilles surlignées en bleu (A2,...) en fonction du numéro de parcelle qui figure en colonne 3 de la feuille "source"

Hello,

Pourquoi tous ces onglets ?

mes onglets en bleu correspondent à mes parcelles

Je veux que toutes les interventions soient dans un fichier global ("source") et ensuite ventilées par parcelle (onglets en bleu)

c'est une demande des utilisateurs

finalement le code me copie bien les lignes de mon tableau

par contre il ne copie que la dernière ligne

Finalement après quelques vérifications le code fonctionne correctement, voici le code final :

Dim j As Integer

Dim LastRow_SOURCE As Long

Dim LastRow As Long

Public Sub Ventilation()

Application.ScreenUpdating = False

'efface les feuilles sauf SOURCE

For j = 8 To 27

With Sheets(j)

'efface les feuilles sauf SOURCE

If .Name <> "Source" Then

LastRow = .Range("A" & Rows.Count).End(xlUp).Row

'controle dans le cas ou la liste est vide

If LastRow > 5 Then .Range("a6:a" & LastRow).EntireRow.Delete

End If

End With

Next j

'on part de la source

LastRow_SOURCE = Sheets("Source").Range("A" & Rows.Count).End(xlUp).Row

'on boucle dans la source

For k = 6 To LastRow_SOURCE

'boucle permettant de lire toutes les 12 feuilles du classeur

For j = 8 To 27

With Sheets(j)

'ventiler les noms de la colonne 7 dans chaque feuille si celui-ci a le meme intitulé que la feuille

If .Name = Sheets("Source").Cells(k, 3).Value Then

LastRow = .Range("A" & Rows.Count).End(xlUp).Row

Sheets("Source").Range("A" & k).EntireRow.Copy

.Cells(LastRow + 1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

End If

End With

Next j

Next k

Application.CutCopyMode = False

Application.ScreenUpdating = True

Sheets("Source").Range("A6:T1000").Copy

Sheets("For R").Range("A:T").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

End Sub

Merci beaucoup pour votre aide