Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

code vba

1 réponse
Avatar
srogeau
BONJOUR a tous
que faut il rajouter au code ci-dessous pour pouvoir utiliser cette macro
mais en meme temps
proteger ma feuille "chaleur"(saisie des donnees qui contient aussi des
formules) et ma feuille "histo" (ou l'on transfere les donnees)
le code ci-dessous qui est dans le module de la feuille 'chaleur'
merci encore
sylvain rogeau

Sub Transferer_Lignes()

Dim NoLignes As Variant, NLig As Variant
Dim Rg As Range, Rg1 As Range, A As Long
Dim Dest As Range

'Les Numéros de lignes à transférer
NoLignes = Application.InputBox("Vos numéros de lignes." & _
"Syntaxe : 1-5-10", "Transfert de lignes", , , , , , 2)

If NoLignes = "Faux" Then Exit Sub

'Détermine où copier les données
With Worksheets("histo")
If .Range("A1") = "" Then
Set Dest = .Range("A1")
Else
Set Dest = .Range("A" & .Range("a65536").End(xlUp)(2).Row)
End If
End With

NLig = Split(NoLignes, "-")

'Identifie la plage à copier
With Worksheets("chaleur")
For A = LBound(NLig) To UBound(NLig)
If IsNumeric(NLig(A)) = True Then
If Rg Is Nothing Then
Set Rg = .Range("a" & NLig(A) & ":P" & NLig(A))
Else
Set Rg = Union(Rg, .Range("a" & NLig(A) & ":P" & NLig(A)))
End If
End If
Next
End With

'Copie la plage
Rg.Copy Dest

'Effacer les données de la plage source H à P inclusivement
For Each are In Rg.Areas
Set Rg1 = are.Offset(, 7).Resize(Rg.Rows.Count, Rg.Columns.Count - 7)
Rg1.ClearContents
Next

'Libère la mémoire
Set Rg = Nothing: Set Rg1 = Nothing: Set Dest = Nothing

End Sub

1 réponse

Avatar
michdenis
Bonjour Srogeau,

Je ne comprends pas ta question ...


Qu'est-ce que tu veux faire des formules qui se trouvent dans ta feuille "chaleur" ?

Tu les copies, en tant que formule, tu ne les copies pas . ou....???

Et si tu les copies, est-ce que tu veux qu'ils conservent un lien avec la feuille d'origine ?


Salutations!


"Srogeau" a écrit dans le message de news:
BONJOUR a tous
que faut il rajouter au code ci-dessous pour pouvoir utiliser cette macro
mais en meme temps
proteger ma feuille "chaleur"(saisie des donnees qui contient aussi des
formules) et ma feuille "histo" (ou l'on transfere les donnees)
le code ci-dessous qui est dans le module de la feuille 'chaleur'
merci encore
sylvain rogeau

Sub Transferer_Lignes()

Dim NoLignes As Variant, NLig As Variant
Dim Rg As Range, Rg1 As Range, A As Long
Dim Dest As Range

'Les Numéros de lignes à transférer
NoLignes = Application.InputBox("Vos numéros de lignes." & _
"Syntaxe : 1-5-10", "Transfert de lignes", , , , , , 2)

If NoLignes = "Faux" Then Exit Sub

'Détermine où copier les données
With Worksheets("histo")
If .Range("A1") = "" Then
Set Dest = .Range("A1")
Else
Set Dest = .Range("A" & .Range("a65536").End(xlUp)(2).Row)
End If
End With

NLig = Split(NoLignes, "-")

'Identifie la plage à copier
With Worksheets("chaleur")
For A = LBound(NLig) To UBound(NLig)
If IsNumeric(NLig(A)) = True Then
If Rg Is Nothing Then
Set Rg = .Range("a" & NLig(A) & ":P" & NLig(A))
Else
Set Rg = Union(Rg, .Range("a" & NLig(A) & ":P" & NLig(A)))
End If
End If
Next
End With

'Copie la plage
Rg.Copy Dest

'Effacer les données de la plage source H à P inclusivement
For Each are In Rg.Areas
Set Rg1 = are.Offset(, 7).Resize(Rg.Rows.Count, Rg.Columns.Count - 7)
Rg1.ClearContents
Next

'Libère la mémoire
Set Rg = Nothing: Set Rg1 = Nothing: Set Dest = Nothing

End Sub