Copier une valeur de cellule sur chaque ligne

Le
Françoise
Et me revoici !!

pouvez-vous m'aider ajouter cette macro :
copie la cellule E4 dans la cellule H de chaque ligne
rsultat 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
Franoise
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Clément Marcotte
Le #1411735
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" 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
Clément Marcotte
Le #1411729
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" 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
Publicité
Poster une réponse
Anonyme