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 Copier une valeur de cellule sur chaque ligne

Copier une valeur de cellule sur chaque ligne

2 réponses
Avatar
Françoise
Et me revoici !!

pouvez-vous m'aider =E0 ajouter =E0 cette macro :
copie la cellule E4 dans la cellule H de chaque ligne=20
r=E9sultat de la macro suivante :
---
Sub (CopieInventaire)
Const x As Integer =3D 7 ' Nombre de colonnes =E0 traiter !
Const InvBook As String =3D "B:\Stocks\MAJStock.xls"
Dim nSheet(1 To 2) As Worksheet, lRow&(1 To 2), i&, j&,y%
Set nSheet(1) =3D Sheets("Produit Consomm=E9")
Application.ScreenUpdating =3D False
Workbooks.Open InvBook
Set nSheet(2) =3D Workbooks("MAJStock").Sheets("Direct")
lRow(1) =3D nSheet(1).Cells(65536, 4).End(xlUp).Row
lRow(2) =3D nSheet(2).Cells(65536, 4).End(xlUp).Row
For i =3D 1 To lRow(1)
Application.StatusBar =3D "Traitement... " & Format(i /=20
lRow(1), "0%")
If nSheet(1).Cells(i, 13) <> "A" And nSheet(1).Cells
(i, 13) <> "B" Then
lRow(2) =3D lRow(2) + 1
For y =3D 1 To x
nSheet(2).Cells(lRow(2), y) =3D nSheet(1).Cells(i, y)
Next y
nSheet(2).Cells(lRow(2), 8) =3D nSheet(1).Cells(4, 5)
End If
Next i
Application.StatusBar =3D False
Workbooks("MAJStock").Close True
nSheet(1).Cells(16, 1).Select
Set nSheet(1) =3D Nothing: Set nSheet(2) =3D Nothing
End Sub
----
D'avance merci
Fran=E7oise
Signaler un problème avec ce contenu

2 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
Avatar
Clément Marcotte
Bonjour,

À l'oeil et pas testé:

Une ligne de plus juste avant le Next i

Sub CopieInventaire()
Const x As Integer = 7 ' Nombre de colonnes à traiter !
Const InvBook As String = "B:StocksMAJStock.xls"
Dim nSheet(1 To 2) As Worksheet, lRow&(1 To 2), i&, j&,y%
Set nSheet(1) = Sheets("Produit Consommé")
Application.ScreenUpdating = False
Workbooks.Open InvBook
Set nSheet(2) = Workbooks("MAJStock").Sheets("Direct")
lRow(1) = nSheet(1).Cells(65536, 4).End(xlUp).Row
lRow(2) = nSheet(2).Cells(65536, 4).End(xlUp).Row
For i = 1 To lRow(1)
Application.StatusBar = "Traitement... " & Format(i /
lRow(1), "0%")
If nSheet(1).Cells(i, 13) <> "A" And nSheet(1).Cells
(i, 13) <> "B" Then
lRow(2) = lRow(2) + 1
For y = 1 To x
nSheet(2).Cells(lRow(2), y) = nSheet(1).Cells(i, y)
Next y
nSheet(2).Cells(lRow(2), 8) = nSheet(1).Cells(4, 5)
End If
cells(i,8).value = Range("e4").value
Next i
Application.StatusBar = False
Workbooks("MAJStock").Close True
nSheet(1).Cells(16, 1).Select
Set nSheet(1) = Nothing: Set nSheet(2) = Nothing
End Sub



"Françoise" a écrit dans le
message de news:ad4101c436a0$45079a90$
Et me revoici !!

pouvez-vous m'aider à ajouter à cette macro :
copie la cellule E4 dans la cellule H de chaque ligne
résultat de la macro suivante :
---
Sub (CopieInventaire)
Const x As Integer = 7 ' Nombre de colonnes à traiter !
Const InvBook As String = "B:StocksMAJStock.xls"
Dim nSheet(1 To 2) As Worksheet, lRow&(1 To 2), i&, j&,y%
Set nSheet(1) = Sheets("Produit Consommé")
Application.ScreenUpdating = False
Workbooks.Open InvBook
Set nSheet(2) = Workbooks("MAJStock").Sheets("Direct")
lRow(1) = nSheet(1).Cells(65536, 4).End(xlUp).Row
lRow(2) = nSheet(2).Cells(65536, 4).End(xlUp).Row
For i = 1 To lRow(1)
Application.StatusBar = "Traitement... " & Format(i /
lRow(1), "0%")
If nSheet(1).Cells(i, 13) <> "A" And nSheet(1).Cells
(i, 13) <> "B" Then
lRow(2) = lRow(2) + 1
For y = 1 To x
nSheet(2).Cells(lRow(2), y) = nSheet(1).Cells(i, y)
Next y
nSheet(2).Cells(lRow(2), 8) = nSheet(1).Cells(4, 5)
End If
Next i
Application.StatusBar = False
Workbooks("MAJStock").Close True
nSheet(1).Cells(16, 1).Select
Set nSheet(1) = Nothing: Set nSheet(2) = Nothing
End Sub
----
D'avance merci
Françoise
Avatar
Clément Marcotte
Bonjour,

En passant, si ton unité B: est une disquette; ce serait plus prudent
de travailler à partir d'un disque rigide, quitte à copier ensuite sur
une disquette.

Les problèmes de corruption de fichier semblent plus nombreux quand
Excel écrit directement un fichier sur disquette.


"Françoise" a écrit dans le
message de news:ad4101c436a0$45079a90$
Et me revoici !!

pouvez-vous m'aider à ajouter à cette macro :
copie la cellule E4 dans la cellule H de chaque ligne
résultat de la macro suivante :
---
Sub (CopieInventaire)
Const x As Integer = 7 ' Nombre de colonnes à traiter !
Const InvBook As String = "B:StocksMAJStock.xls"
Dim nSheet(1 To 2) As Worksheet, lRow&(1 To 2), i&, j&,y%
Set nSheet(1) = Sheets("Produit Consommé")
Application.ScreenUpdating = False
Workbooks.Open InvBook
Set nSheet(2) = Workbooks("MAJStock").Sheets("Direct")
lRow(1) = nSheet(1).Cells(65536, 4).End(xlUp).Row
lRow(2) = nSheet(2).Cells(65536, 4).End(xlUp).Row
For i = 1 To lRow(1)
Application.StatusBar = "Traitement... " & Format(i /
lRow(1), "0%")
If nSheet(1).Cells(i, 13) <> "A" And nSheet(1).Cells
(i, 13) <> "B" Then
lRow(2) = lRow(2) + 1
For y = 1 To x
nSheet(2).Cells(lRow(2), y) = nSheet(1).Cells(i, y)
Next y
nSheet(2).Cells(lRow(2), 8) = nSheet(1).Cells(4, 5)
End If
Next i
Application.StatusBar = False
Workbooks("MAJStock").Close True
nSheet(1).Cells(16, 1).Select
Set nSheet(1) = Nothing: Set nSheet(2) = Nothing
End Sub
----
D'avance merci
Françoise