Bonjour à tous
j'utilise cette macro pour incrémenter des données dans un classeur fermé.
mes données s'incrémentent sur 11 colonnes et à la suite de ligne en ligne.
je cherche à ce que ces données s'incrémentent à la suite en fonction de la 1er cellule vide colonne A
donc se positionner sur la 1ere cellule vide colonne A et uniquement colonne A et incrémenter.
car dans une 12ème colonne se trouve des formules sur toute la colonne et l'incrémentation se fait alors par rapport à la dernière cellule vide
Merci de votre aide
Sub Macro2()
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim Fichier As String, Cible As String, Feuille As String
Dim i As Byte
Dte = Format(Date, "dd/mm/yy")
Hre = Format(Now, "hh:mm")
Fichier = "C:\Documents and Settings\Jtitin\Bureau\rapport\MonFichier.xls"
Feuille = "sauvegarde$"
Set Cn = New ADODB.Connection
Cn.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & _
"data source=" & Fichier & ";" & _
"extended properties=""Excel 8.0;"""
Cible = "SELECT * FROM [" & Feuille & "];"
Set Rs = New Recordset
Rs.Open Cible, Cn, adOpenKeyset, adLockOptimistic
With Rs
.AddNew
.Fields(0) = Sheets("Feuil1").Range("F9")
.Fields(1) = Format(CDate(Sheets("Feuil1").Range("H9")), "hh:mm")
.Fields(2) = Dte
.Fields(3) = Hre
.Fields(4) = Sheets("FINAL").Range("CS28")
.Fields(5) = Sheets("FINAL").Range("A4")
.Fields(6) = Sheets("FINAL").Range("E4")
.Fields(7) = Sheets("FINAL").Range("C28")
.Fields(8) = Sheets("FINAL").Range("E28")
.Fields(9) = Sheets("FINAL").Range("G30")
.Fields(10) = Sheets("FINAL").Range("M30")
.Update
End With
Rs.Close
Cn.Close
End Sub
j'utilise cette macro pour incrémenter des données dans un classeur fermé.
mes données s'incrémentent sur 11 colonnes et à la suite de ligne en ligne.
je cherche à ce que ces données s'incrémentent à la suite en fonction de la 1er cellule vide colonne A
donc se positionner sur la 1ere cellule vide colonne A et uniquement colonne A et incrémenter.
car dans une 12ème colonne se trouve des formules sur toute la colonne et l'incrémentation se fait alors par rapport à la dernière cellule vide
Merci de votre aide
Sub Macro2()
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim Fichier As String, Cible As String, Feuille As String
Dim i As Byte
Dte = Format(Date, "dd/mm/yy")
Hre = Format(Now, "hh:mm")
Fichier = "C:\Documents and Settings\Jtitin\Bureau\rapport\MonFichier.xls"
Feuille = "sauvegarde$"
Set Cn = New ADODB.Connection
Cn.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & _
"data source=" & Fichier & ";" & _
"extended properties=""Excel 8.0;"""
Cible = "SELECT * FROM [" & Feuille & "];"
Set Rs = New Recordset
Rs.Open Cible, Cn, adOpenKeyset, adLockOptimistic
With Rs
.AddNew
.Fields(0) = Sheets("Feuil1").Range("F9")
.Fields(1) = Format(CDate(Sheets("Feuil1").Range("H9")), "hh:mm")
.Fields(2) = Dte
.Fields(3) = Hre
.Fields(4) = Sheets("FINAL").Range("CS28")
.Fields(5) = Sheets("FINAL").Range("A4")
.Fields(6) = Sheets("FINAL").Range("E4")
.Fields(7) = Sheets("FINAL").Range("C28")
.Fields(8) = Sheets("FINAL").Range("E28")
.Fields(9) = Sheets("FINAL").Range("G30")
.Fields(10) = Sheets("FINAL").Range("M30")
.Update
End With
Rs.Close
Cn.Close
End Sub