1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
| Private Const BDX_COL_INFO = 1
Public wbFicImport As Workbook
Public shSource As Worksheet
Public shImport As Worksheet
Private Sub btnImport_Click()
Dim obFdOpen As FileDialog
Dim szFicNom As String
Dim inNbOnglets As Integer
'Ouverture du fichier à importer
Set obFdOpen = Application.FileDialog(msoFileDialogOpen)
obFdOpen.Title = "Ouvrir un fichier sur lequel importer des onglets"
If obFdOpen.Show = -1 Then
szFicNom = obFdOpen.SelectedItems(1)
Else
Exit Sub
End If
Set wbFicImport = Workbooks.Open(szFicNom)
Me.FrameImporter.Visible = True
Me.ioLabel.Visible = True
Me.cbOnglets.Visible = True
Me.btnImportOnglet.Visible = True
For Each shImport In wbFicImport.Sheets
Me.cbOnglets.AddItem shImport.Name
Next shImport
ThisWorkbook.Activate
End Sub
Private Sub btnImportOnglet_Click()
Dim inBcl As Integer
Dim inSourceDeb As Integer
Dim inSourceFin As Integer
Dim inImportDeb As Integer
Dim inImportFin As Integer
'On cherche début et fin de la zone bordereau source
Set shSource = ThisWorkbook.Sheets(Me.cbOnglets.Value)
inBcl = 1
While shSource.Cells(inBcl, BDX_COL_INFO).Value <> "F"
If shSource.Cells(inBcl, BDX_COL_INFO).Value = "D" Then inSourceDeb = inBcl + 1
inBcl = inBcl + 1
Wend
inSourceFin = inBcl - 1
'On cherche début et fin de la zone bordereau à importer
Set shImport = wbFicImport.Sheets(Me.cbOnglets.Value)
inBcl = 1
While shImport.Cells(inBcl, BDX_COL_INFO).Value <> "F"
If shImport.Cells(inBcl, BDX_COL_INFO).Value = "D" Then inImportDeb = inBcl + 1
inBcl = inBcl + 1
Wend
inImportFin = inBcl - 1
'Suppression des lignes et copier coller
shSource.Range(Cells(inSourceDeb, 1), Cells(inSourceFin, 1)).EntireRow.Delete Shift:=xlUp
shImport.Range(Cells(inImportDeb, 1), Cells(inImportFin, 1)).EntireRow.Copy
shSource.Range(Cells(inSourceFin, 1), Cells(inSourceFin, 1)).Insert Shift:=xlDown
End Sub |