Insérer une ligne dans un tableau
Bonjour à tous !
Je ne m'y connait à peu près pas en VBA et là je suis complètement coincée avec une macro.
En fait, la macro est faite pour qu'une ligne s'ajoute à la fin du tableau et ajoute une ligne vierge par la suite.
Je voudrais remplacer cette fonction pour que la ligne s'ajoute automatiquement à la ligne 5 du tableau sans ajouter de ligne vierge à la fin.
Quelqu'un peut m'aider SVP !? :)
Voici la macro :
Sub TRANSCRIBE_MULTIPLE_FORMS()
Dim source As Workbook, db As Workbook
Dim source_sh As Worksheet, db_sh As Worksheet
Dim rngCopy As Range, rngPaste As Range
Dim fileName As String, dbName As String, dbSheet As String, profSheet As String
Dim lRow As Long, fRow As Long
Dim fileArray As Variant
dbName = "Relevé des usagers 2020-2021.xlsm" '***Change workbook name here***
dbSheet = "Dossiers 2020-2021" '***Change sheet name here***
profSheet = "Profil type" '***Change sheet name here***
fRow = 4 '***Change first row of table here***
Application.ScreenUpdating = False
'User selects file
fileArray = Application.GetOpenFilename("Excel Files (*.xls*), *xls*", Title:="Choose the source file", MultiSelect:=True)
' Iterate through selected files
If IsArray(fileArray) Then
For i = LBound(fileArray) To UBound(fileArray)
fileName = fileArray(i)
TRANSCRIBE_SINGLE_FORM fileName, dbName, dbSheet, profSheet, fRow
Next i
Else
MsgBox "Exiting: You must select a file!"
End If
End Sub
Private Sub TRANSCRIBE_SINGLE_FORM(fileName As String, dbName As String, dbSheet As String, profSheet As String, fRow As Long)
'Get Workbooks
Set source = Workbooks.Open(fileName)
Set db = Workbooks(dbName)
'Get Sheets
Set source_sh = source.Sheets(profSheet)
Set db_sh = db.Sheets(dbSheet)
'Get next empty row in table
lRow = db_sh.Cells(Rows.Count, 2).End(xlUp).Row + 1
' Skip to first data row of table if this is the first entry
If lRow < fRow Then
lRow = fRow
End If
'Add a row to the table by copying format
Set rngCopy = db_sh.Range("A4:X4")
Set rngPaste = db_sh.Cells(lRow, 1)
rngCopy.Copy
rngPaste.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
'Transfer values
db_sh.Cells(lRow, 1).Value = lRow - 3 'Primary key
db_sh.Cells(lRow, 2).Value = source_sh.Range("D5") 'Nom
db_sh.Cells(lRow, 3).Value = source_sh.Range("R5") 'Prenom
db_sh.Cells(lRow, 4).Value = source_sh.Range("AA5") 'DDN
db_sh.Cells(lRow, 5).Value = source_sh.Range("F6") '#Dosssier
db_sh.Cells(lRow, 6).Value = source_sh.Range("AC6") 'Age
db_sh.Cells(lRow, 7).Value = source_sh.Range("AB7") 'Langue
db_sh.Cells(lRow, 8).Value = source_sh.Range("S6") 'Ref
db_sh.Cells(lRow, 9).Value = source_sh.Range("W6") 'SCC
db_sh.Cells(lRow, 10).Value = source_sh.Range("S8") 'IC
db_sh.Cells(lRow, 11).Value = source_sh.Range("AC9") 'ARC
db_sh.Cells(lRow, 12).Value = source_sh.Range("H32") 'Sentence
db_sh.Cells(lRow, 13).Value = source_sh.Range("W32") 'Prise en charge
db_sh.Cells(lRow, 14).Value = source_sh.Range("G19") 'Infraction
db_sh.Cells(lRow, 15).Value = source_sh.Range("I12") 'VC
db_sh.Cells(lRow, 16).Value = source_sh.Range("W43") 'Date fin prevue
db_sh.Cells(lRow, 17).Value = source_sh.Range("U35") 'Date fin actuelle
'db_sh.Cells(lRow, 18).Value = N/a 'Remise du rapport
db_sh.Cells(lRow, 19).Value = source_sh.Range("Z35") 'Motif
db_sh.Cells(lRow, 20).Value = source_sh.Range("K7") 'Statut
db_sh.Cells(lRow, 21).Value = source_sh.Range("T7") 'Freq
db_sh.Cells(lRow, 22).Value = source_sh.Range("D7") 'Cote
db_sh.Cells(lRow, 23).Value = source_sh.Range("A35") 'Mesure
'Tranfer custom cell formats
db_sh.Cells(lRow, 6).NumberFormat = source_sh.Range("AC6").NumberFormat
'Close the source file
source.Close SaveChanges:=False
End Sub
Private Sub hyperlink()
With db_sh
.Hyperlinks.Add Anchor:=.Cells(lRow, 24), _
Address:=fileName, _
ScreenTip:="Voir le rapport détaillé: " + fileName, _
TextToDisplay:="Dossier"
End With
End Sub
Bonjour Melissa08,
De plus, as-tu cherché un petit peu ?
https://www.google.com/search?q=insrtion+ligne+vbz&oq=insrtion+ligne+vbz&aqs=chrome..69i57.4032j0j1&...
Bonne soirée,
Baboutz
Bonjour Baboutz,
En effet, je sais qu'il s'agit d'un code très simple. J'ai essayé de plusieurs façons de l'intégrer à mon fichier, en vain. C'est pourquoi je me suis tournée vers vous pour obtenir de l'aide.
Comme mon second petit panneau l'indiquait, merci de me joindre un fichier anonymisé afin de t'aider