Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel copie plage discontinue ( et en partie variable) VBA

copie plage discontinue ( et en partie variable) VBA

11 réponses
Avatar
J
Bonjour à tous,
j'essaie (en vain), pour tout pleins de feuilles,
de copier par VBA dans la première ligne vide d'une feuille de bilan :
en B et C je souhaite recopier les données d'origine de "K13 à Lder cel
remplie"
et pour chaque ligne où BC seront remplies, en A je souhaite recopier
"A1&B1" de la feuille d'origine,

je n'arrive à rien du tout d'utilisable

Y-a-t-il une âme charitable pour retoucher ma proc???
Merci d'avance
J@@
'*******
Sub Consolidtest()
Dim Feuille As Worksheet

For Each Feuille In ActiveWorkbook.Worksheets
If Feuille.Name <> "Bilan" _
And Feuille.Name <> "ListePel" Then
'si a13 de la feuille active n'est pas vide
'copie de "A1&C1 et de "K13:L13 à fin K:L" de la feuille active vers
'la première ligne vide, à partir de A7, de la feuille "Bilan".
If Feuille.Range("R1").Value = "Tahiti" _
And Feuille.Range("A13").Value <> "" Then
With Feuille
.Range("A1&B1", .Range("K65536:L65536").End(xlUp)).Copy _
'<=PLANTE
Destination:=Sheets("Bilan"). _
Range("A65536").End(xlUp)(2)
End With
Else: End If
End If
Next Feuille
End Sub
'********
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Papyty
Bonjour @ tous et à J@@ :
je n'arrive à rien du tout d'utilisable


Bon j'ai essayé de suivre les consignes:

Sub Consolidtest()
Dim sFeuille As Worksheet
Dim DerligSource As Double, DerligTarget As Double

For Each sFeuille In ActiveWorkbook.Worksheets
With sFeuille
If .Name <> "Bilan" _
And .Name <> "ListePel" Then
'si a13 de la sFeuille active n'est pas vide et R1 = Tahiti
'copie de "A1&C1 et de "K13:L13 à fin K:L" de la feuille active vers
'la première ligne vide, à partir de A7, de la feuille "Bilan".
'en A je souhaite recopier "A1&B1" de la feuille d'origine,
'en B et C je souhaite recopier les données d'origine de "K13 à Lder cel
If .[R1] = "Tahiti" _
And .[A13] <> "" Then
DerligSource = .[K65536:L65536].End(xlUp).Row
DerligTarget = Worksheets("Bilan"). _
[A65536].End(xlUp).Row + 1
If DerligTarget < 7 Then DerligTarget = 7
Worksheets("Bilan"). _
Range("a" & DerligTarget & ":a" & DerligTarget + _
DerligSource - 13) = .[A1] & " " & [B1]
.Range("K13:L" & DerligSource).Copy _
Destination:=Worksheets("Bilan"). _
Range("B" & DerligTarget)
End If
End If
End With
Next sFeuille
End Sub

Est ce que ça va??
--
@+
Thierry
28/12/2003 03:07:44

Avatar
Papyty
Bonjour @ tous et à Papyty :
Bon j'ai essayé de suivre les consignes:


Un point à disparu donc voili:

Sub Consolidtest()
Dim sFeuille As Worksheet
Dim DerligSource As Double, DerligTarget As Double

For Each sFeuille In ActiveWorkbook.Worksheets
With sFeuille
If .Name <> "Bilan" _
And .Name <> "ListePel" Then
'si a13 de la sFeuille active n'est pas vide et R1 = Tahiti
'copie de "A1&C1 et de "K13:L13 à fin K:L" de la feuille active vers
'la première ligne vide, à partir de A7, de la feuille "Bilan".
'en A je souhaite recopier "A1&B1" de la feuille d'origine,
'en B et C je souhaite recopier les données d'origine de "K13 à Lder cel
If .[R1] = "Tahiti" _
And .[A13] <> "" Then
DerligSource = .[K65536:L65536].End(xlUp).Row
DerligTarget = Worksheets("Bilan"). _
[A65536].End(xlUp).Row + 1
If DerligTarget < 7 Then DerligTarget = 7
Worksheets("Bilan"). _
Range("a" & DerligTarget & ":a" & DerligTarget + _
DerligSource - 13) = .[A1] & " " & .[B1]
.Range("K13:L" & DerligSource).Copy _
Destination:=Worksheets("Bilan"). _
Range("B" & DerligTarget)
End If
End If
End With
Next sFeuille
End Sub
--
@+
Thierry
28/12/2003 03:12:49

Avatar
J
Bonjour "Papyty"
C'est quasi parfait, manque juste la concaténation A1&C1 de la Source
qui devrait venir se coller en A de la Target.
Si c'était pas trop demander, encore un petit coup de main :-)))
Merci à toi
@+
J@@


"Papyty" :
Bon j'ai essayé de suivre les consignes:
Un point à disparu donc voili:


Sub Consolidtest()
Dim sFeuille As Worksheet
Dim DerligSource As Double, DerligTarget As Double

For Each sFeuille In ActiveWorkbook.Worksheets
With sFeuille
If .Name <> "Bilan" _
And .Name <> "ListePel" Then
'si a13 de la sFeuille active n'est pas vide et R1 = Tahiti
'copie de "A1&C1 et de "K13:L13 à fin K:L" de la feuille active vers
'la première ligne vide, à partir de A7, de la feuille "Bilan".
'en A je souhaite recopier "A1&B1" de la feuille d'origine,
'en B et C je souhaite recopier les données d'origine de "K13 à Lder
cel

If .[R1] = "Tahiti" _
And .[A13] <> "" Then
DerligSource = .[K65536:L65536].End(xlUp).Row
DerligTarget = Worksheets("Bilan"). _
[A65536].End(xlUp).Row + 1
If DerligTarget < 7 Then DerligTarget = 7
Worksheets("Bilan"). _
Range("a" & DerligTarget & ":a" & DerligTarget + _
DerligSource - 13) = .[A1] & " " & .[B1]
.Range("K13:L" & DerligSource).Copy _
Destination:=Worksheets("Bilan"). _
Range("B" & DerligTarget)
End If
End If
End With
Next sFeuille
End Sub
--
@+
Thierry
28/12/2003 03:12:49



Avatar
J
Re-bonjour, Papyty
Tout est bon c'est juste que la concaténation est A&C, j'ai fait la
retouche et tout va bien :-)))))))
encore merci
bon dimanche (il est tôt dis-donc chez toi ;-)
et joyeuses fêtes
@+
J@@

"Papyty" <:
Bon j'ai essayé de suivre les consignes:


Un point à disparu donc voili:

Sub Consolidtest()
Dim sFeuille As Worksheet
Dim DerligSource As Double, DerligTarget As Double

For Each sFeuille In ActiveWorkbook.Worksheets
With sFeuille
If .Name <> "Bilan" _
And .Name <> "ListePel" Then
'si a13 de la sFeuille active n'est pas vide et R1 = Tahiti
'copie de "A1&C1 et de "K13:L13 à fin K:L" de la feuille active vers
'la première ligne vide, à partir de A7, de la feuille "Bilan".
'en A je souhaite recopier "A1&B1" de la feuille d'origine,
'en B et C je souhaite recopier les données d'origine de "K13 à Lder
cel

If .[R1] = "Tahiti" _
And .[A13] <> "" Then
DerligSource = .[K65536:L65536].End(xlUp).Row
DerligTarget = Worksheets("Bilan"). _
[A65536].End(xlUp).Row + 1
If DerligTarget < 7 Then DerligTarget = 7
Worksheets("Bilan"). _
Range("a" & DerligTarget & ":a" & DerligTarget + _
DerligSource - 13) = .[A1] & " " & .[B1]
.Range("K13:L" & DerligSource).Copy _
Destination:=Worksheets("Bilan"). _
Range("B" & DerligTarget)
End If
End If
End With
Next sFeuille
End Sub
--
@+
Thierry
28/12/2003 03:12:49



Avatar
Papyty
Bonjour @ tous et à J@@ :
C'est quasi parfait, manque juste la concaténation A1&C1 de la Source


Erreur je concatenais A1&B1
Voici la correction:

Sub Consolidtest()
Dim sFeuille As Worksheet
Dim DerligSource As Double, DerligTarget As Double

For Each sFeuille In ActiveWorkbook.Worksheets
With sFeuille
If .Name <> "Bilan" _
And .Name <> "ListePel" Then
'si a13 de la sFeuille active n'est pas vide et R1 = Tahiti
'copie de "A1&C1 et de "K13:L13 à fin K:L" de la feuille active vers
'la première ligne vide, à partir de A7, de la feuille "Bilan".
'en A je souhaite recopier "A1&B1" de la feuille d'origine,
'en B et C je souhaite recopier les données d'origine de "K13 à Lder cel
If .[R1] = "Tahiti" _
And .[A13] <> "" Then
DerligSource = .[K65536:L65536].End(xlUp).Row
DerligTarget = Worksheets("Bilan"). _
[A65536].End(xlUp).Row + 1
If DerligTarget < 7 Then DerligTarget = 7
Worksheets("Bilan"). _
Range("a" & DerligTarget & ":a" & DerligTarget + _
DerligSource - 13) = .[A1] & " " & .[C1]
.Range("K13:L" & DerligSource).Copy _
Destination:=Worksheets("Bilan"). _
Range("B" & DerligTarget)
End If
End If
End With
Next sFeuille
End Sub

Est ce que c'est correct??
--
@+
Thierry
28/12/2003 12:44:12

Avatar
J
Bonjour à tous et à Papyty
Grâce à Papity j'ai la macro suivante qui marche très bien.
mais les données copiées (colonne K) ont une MEFC, qui est
malheureusement embarquée par la copie et pose problème,
comment ne copier que la valeur??? j'ai tenté de rajouter Value,
xlValues un peu partout mais sans succès.
A votre bon coeur, un petit coup de main...
@+ Merci d'avance
J@@

"Papyty" <
Sub Consolidtest()
Dim sFeuille As Worksheet
Dim DerligSource As Double, DerligTarget As Double

For Each sFeuille In ActiveWorkbook.Worksheets
With sFeuille
If .Name <> "Bilan" _
And .Name <> "ListePel" Then
'si a13 de la sFeuille active n'est pas vide et R1 = Tahiti
'copie de "A1&C1 et de "K13:L13 à fin K:L" de la feuille active vers
'la première ligne vide, à partir de A7, de la feuille "Bilan".
'en A je souhaite recopier "A1&B1" de la feuille d'origine,
'en B et C je souhaite recopier les données d'origine de "K13 à Lder
cel

If .[R1] = "Tahiti" _
And .[A13] <> "" Then
DerligSource = .[K65536:L65536].End(xlUp).Row
DerligTarget = Worksheets("Bilan"). _
[A65536].End(xlUp).Row + 1
If DerligTarget < 7 Then DerligTarget = 7
Worksheets("Bilan"). _
Range("a" & DerligTarget & ":a" & DerligTarget + _
DerligSource - 13) = .[A1] & " " & .[C1]
.Range("K13:L" & DerligSource).Copy _ '<==== j'ai
essayé d'ajouté value là, ça plante...

Destination:=Worksheets("Bilan"). _
Range("B" & DerligTarget)
End If
End If
End With
Next sFeuille
End Sub

@+
Thierry
28/12/2003 12:44:12


Avatar
isabelle
bonjour J@@,

tu pourrait ajouter les deux lignes suivantes après :
.Range("K13:L" & DerligSource).Copy _
Destination:=Worksheets("Bilan").Range("B" & DerligTarget)


Worksheets("Bilan").Range("H" & DerligTarget & ":h" & DerligTarget +
DerligSource - 1).Copy
Worksheets("Bilan").Range("H" & DerligTarget & ":h" & DerligTarget +
DerligSource - 1).PasteSpecial Paste:=xlPasteValues

isabelle


Bonjour à tous et à Papyty
Grâce à Papity j'ai la macro suivante qui marche très bien.
mais les données copiées (colonne K) ont une MEFC, qui est
malheureusement embarquée par la copie et pose problème,
comment ne copier que la valeur??? j'ai tenté de rajouter Value,
xlValues un peu partout mais sans succès.
A votre bon coeur, un petit coup de main...
@+ Merci d'avance
J@@

"Papyty" <
Sub Consolidtest()
Dim sFeuille As Worksheet
Dim DerligSource As Double, DerligTarget As Double

For Each sFeuille In ActiveWorkbook.Worksheets
With sFeuille
If .Name <> "Bilan" _
And .Name <> "ListePel" Then
'si a13 de la sFeuille active n'est pas vide et R1 = Tahiti
'copie de "A1&C1 et de "K13:L13 à fin K:L" de la feuille active vers
'la première ligne vide, à partir de A7, de la feuille "Bilan".
'en A je souhaite recopier "A1&B1" de la feuille d'origine,
'en B et C je souhaite recopier les données d'origine de "K13 à Lder
cel

If .[R1] = "Tahiti" _
And .[A13] <> "" Then
DerligSource = .[K65536:L65536].End(xlUp).Row
DerligTarget = Worksheets("Bilan"). _
[A65536].End(xlUp).Row + 1
If DerligTarget < 7 Then DerligTarget = 7
Worksheets("Bilan"). _
Range("a" & DerligTarget & ":a" & DerligTarget + _
DerligSource - 13) = .[A1] & " " & .[C1]
.Range("K13:L" & DerligSource).Copy _ '<==== j'ai
essayé d'ajouté value là, ça plante...

Destination:=Worksheets("Bilan"). _
Range("B" & DerligTarget)
End If
End If
End With
Next sFeuille
End Sub

@+
Thierry
28/12/2003 12:44:12




Avatar
J
Bonjour Isabelle (pas trop de neige à Montréal?)
Cela ne marche pas, mes données à pb sont collées en colonne B, j'ai
modifié ta proposition, mais je ne vois toujours rien,as-tu une idée??
Merci à toi
@+
J@@

Worksheets("Bilan"). _
Range("a" & DerligTarget & ":a" & DerligTarget + _
DerligSource - 13) = .[A1] & " " & .[C1]
.Range("K13:L" & DerligSource).Copy _
Destination:=Worksheets("Bilan"). _
Range("B" & DerligTarget)

Worksheets("Bilan"). _
Range("B" & DerligTarget & ":b" & DerligTarget + _
DerligSource - 1).Copy
Worksheets("Bilan"). _
Range("B" & DerligTarget & ":b" & DerligTarget + _
DerligSource - 1).PasteSpecial Paste:=xlPasteValues


"isabelle" <
tu pourrait ajouter les deux lignes suivantes après :
.Range("K13:L" & DerligSource).Copy _
Destination:=Worksheets("Bilan").Range("B" & DerligTarget)


Worksheets("Bilan").Range("H" & DerligTarget & ":h" & DerligTarget +
DerligSource - 1).Copy
Worksheets("Bilan").Range("H" & DerligTarget & ":h" & DerligTarget +
DerligSource - 1).PasteSpecial Paste:=xlPasteValues

isabelle


Bonjour à tous et à Papyty
Grâce à Papity j'ai la macro suivante qui marche très bien.
mais les données copiées (colonne K) ont une MEFC, qui est
malheureusement embarquée par la copie et pose problème,
comment ne copier que la valeur??? j'ai tenté de rajouter Value,
xlValues un peu partout mais sans succès.
A votre bon coeur, un petit coup de main...
@+ Merci d'avance
J@@

"Papyty" <
Sub Consolidtest()
Dim sFeuille As Worksheet
Dim DerligSource As Double, DerligTarget As Double

For Each sFeuille In ActiveWorkbook.Worksheets
With sFeuille
If .Name <> "Bilan" _
And .Name <> "ListePel" Then
'si a13 de la sFeuille active n'est pas vide et R1 = Tahiti
'copie de "A1&C1 et de "K13:L13 à fin K:L" de la feuille active
vers



'la première ligne vide, à partir de A7, de la feuille "Bilan".
'en A je souhaite recopier "A1&B1" de la feuille d'origine,
'en B et C je souhaite recopier les données d'origine de "K13 à
Lder



cel
If .[R1] = "Tahiti" _
And .[A13] <> "" Then
DerligSource = .[K65536:L65536].End(xlUp).Row
DerligTarget = Worksheets("Bilan"). _
[A65536].End(xlUp).Row + 1
If DerligTarget < 7 Then DerligTarget = 7
Worksheets("Bilan"). _
Range("a" & DerligTarget & ":a" & DerligTarget + _
DerligSource - 13) = .[A1] & " " & .[C1]
.Range("K13:L" & DerligSource).Copy _ '<=== j'ai
essayé d'ajouté value là, ça plante...

Destination:=Worksheets("Bilan"). _
Range("B" & DerligTarget)
End If
End If
End With
Next sFeuille
End Sub

@+
Thierry
28/12/2003 12:44:12






Avatar
J
Re Bonjour Isabelle
en fait le pb est que la MEFC est copiée, mais n'est pas modifiée
ensuite par le copié-collage du format que réalise ta proposition
Comment supprimer cette Mefc??
merci à toi
à+
J@@

Worksheets("Bilan"). _
Range("B" & DerligTarget & ":b" & DerligTarget + _
DerligSource - 1).Copy
Worksheets("Bilan"). _
Range("B" & DerligTarget & ":b" & DerligTarget + _
DerligSource - 1).PasteSpecial Paste:=xlPasteValues

"isabelle" <

tu pourrait ajouter les deux lignes suivantes après :
.Range("K13:L" & DerligSource).Copy _
Destination:=Worksheets("Bilan").Range("B" & DerligTarget)


Worksheets("Bilan").Range("H" & DerligTarget & ":h" & DerligTarget +
DerligSource - 1).Copy
Worksheets("Bilan").Range("H" & DerligTarget & ":h" & DerligTarget +
DerligSource - 1).PasteSpecial Paste:=xlPasteValues

isabelle


Bonjour à tous et à Papyty
Grâce à Papity j'ai la macro suivante qui marche très bien.
mais les données copiées (colonne K) ont une MEFC, qui est
malheureusement embarquée par la copie et pose problème,
comment ne copier que la valeur??? j'ai tenté de rajouter Value,
xlValues un peu partout mais sans succès.
A votre bon coeur, un petit coup de main...
@+ Merci d'avance
J@@

"Papyty" <
Sub Consolidtest()
Dim sFeuille As Worksheet
Dim DerligSource As Double, DerligTarget As Double

For Each sFeuille In ActiveWorkbook.Worksheets
With sFeuille
If .Name <> "Bilan" _
And .Name <> "ListePel" Then
'si a13 de la sFeuille active n'est pas vide et R1 = Tahiti
'copie de "A1&C1 et de "K13:L13 à fin K:L" de la feuille active
vers



'la première ligne vide, à partir de A7, de la feuille "Bilan".
'en A je souhaite recopier "A1&B1" de la feuille d'origine,
'en B et C je souhaite recopier les données d'origine de "K13 à
Lder



cel
If .[R1] = "Tahiti" _
And .[A13] <> "" Then
DerligSource = .[K65536:L65536].End(xlUp).Row
DerligTarget = Worksheets("Bilan"). _
[A65536].End(xlUp).Row + 1
If DerligTarget < 7 Then DerligTarget = 7
Worksheets("Bilan"). _
Range("a" & DerligTarget & ":a" & DerligTarget + _
DerligSource - 13) = .[A1] & " " & .[C1]
.Range("K13:L" & DerligSource).Copy _ '<=== j'ai
essayé d'ajouté value là, ça plante...

Destination:=Worksheets("Bilan"). _
Range("B" & DerligTarget)
End If
End If
End With
Next sFeuille
End Sub

@+
Thierry
28/12/2003 12:44:12






Avatar
isabelle
bonjour J@@,

j'avions lu trop trop vite, est ce que comme ça, ça va ?

Range("B" & DerligTarget & ":b" & DerligTarget + DerligSource -
1).FormatConditions.Delete

isabelle


Re Bonjour Isabelle
en fait le pb est que la MEFC est copiée, mais n'est pas modifiée
ensuite par le copié-collage du format que réalise ta proposition
Comment supprimer cette Mefc??
merci à toi
à+
J@@

Worksheets("Bilan"). _
Range("B" & DerligTarget & ":b" & DerligTarget + _
DerligSource - 1).Copy
Worksheets("Bilan"). _
Range("B" & DerligTarget & ":b" & DerligTarget + _
DerligSource - 1).PasteSpecial Paste:=xlPasteValues

"isabelle" <

tu pourrait ajouter les deux lignes suivantes après :
.Range("K13:L" & DerligSource).Copy _
Destination:=Worksheets("Bilan").Range("B" & DerligTarget)


Worksheets("Bilan").Range("H" & DerligTarget & ":h" & DerligTarget +
DerligSource - 1).Copy
Worksheets("Bilan").Range("H" & DerligTarget & ":h" & DerligTarget +
DerligSource - 1).PasteSpecial Paste:=xlPasteValues

isabelle


Bonjour à tous et à Papyty
Grâce à Papity j'ai la macro suivante qui marche très bien.
mais les données copiées (colonne K) ont une MEFC, qui est
malheureusement embarquée par la copie et pose problème,
comment ne copier que la valeur??? j'ai tenté de rajouter Value,
xlValues un peu partout mais sans succès.
A votre bon coeur, un petit coup de main...
@+ Merci d'avance
J@@

"Papyty" <
Sub Consolidtest()
Dim sFeuille As Worksheet
Dim DerligSource As Double, DerligTarget As Double

For Each sFeuille In ActiveWorkbook.Worksheets
With sFeuille
If .Name <> "Bilan" _
And .Name <> "ListePel" Then
'si a13 de la sFeuille active n'est pas vide et R1 = Tahiti
'copie de "A1&C1 et de "K13:L13 à fin K:L" de la feuille active
vers



'la première ligne vide, à partir de A7, de la feuille "Bilan".
'en A je souhaite recopier "A1&B1" de la feuille d'origine,
'en B et C je souhaite recopier les données d'origine de "K13 à
Lder



cel
If .[R1] = "Tahiti" _
And .[A13] <> "" Then
DerligSource = .[K65536:L65536].End(xlUp).Row
DerligTarget = Worksheets("Bilan"). _
[A65536].End(xlUp).Row + 1
If DerligTarget < 7 Then DerligTarget = 7
Worksheets("Bilan"). _
Range("a" & DerligTarget & ":a" & DerligTarget + _
DerligSource - 13) = .[A1] & " " & .[C1]
.Range("K13:L" & DerligSource).Copy _ '<=== > j'ai
essayé d'ajouté value là, ça plante...

Destination:=Worksheets("Bilan"). _
Range("B" & DerligTarget)
End If
End If
End With
Next sFeuille
End Sub

@+
Thierry
28/12/2003 12:44:12








1 2