Discussion :

[ANANA49]

Bonjour,

Je souhaiterai via un formulaire Access, exporter des données provenant d'un classeur Excel sur un autre classeur existant en incluant les conditions :

S'il trouve dans la colonne A de ma feuille "export" du classeur source, le chiffre 7, il doit prendre toutes les lignes au dessus (de 1 à 6 inclus) et les copier sur ma feuille "Tranche" de mon classeur destination en cellule A7.

Autre condition :

S'il trouve dans la colonne A de ma feuille "export", le chiffre 6, il doit prendre toutes les lignes en dessous (de 7 à ....) et les copier sur ma feuille "Tranche" en cellule A23.

J'ai réadapté un bout de code (Merci à tee_grandbois), pour la première condition (Il fonctionne mais un peu long) mais j'ai du mal avec la deuxième condition qui doit récupérer les lignes en-dessous de la valeur "6".

Merci pour votre aide.
Mon bout de code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Btn_ExportParTranche_Click()
Dim xlApp As Object
Dim xlWbk1 As Object, xlWbk2 As Object
Dim xlWsh1 As Object, xlWsh2 As Object
Dim strFicSource As String
Dim strFicDestin As String
Dim L As Long
Dim lgDerlig1 As Long
Dim lgDerLig2 As Long
 
Set xlApp = CreateObject("Excel.application")
'fichiers du traitement
strFicSource = "C:\SourceTranche.xlsx"
strFicDestin = "C:\BDD_Courriers.xlsm"
 
 
Set xlWbk1 = xlApp.Workbooks.Open(strFicSource)
Set xlWbk2 = xlApp.Workbooks.Open(strFicDestin, Password:="pat01")
 
'feuilles du traitement
Set xlWsh1 = xlWbk1.Worksheets("export")
Set xlWsh2 = xlWbk2.Worksheets("Tranche")
 
'récupération du dernier enregistrement de chaque classeur
lgDerlig1 = xlWsh1.UsedRange.Rows.Count
lgDerLig2 = xlWsh2.UsedRange.Rows.Count
 
xlApp.Visible = True
 
With xlWsh1
    'lecture du classeur source à parir de la ligne 5
    For L = 1 To lgDerlig1
        ' fin du traitement si valeur est trouvé en cellule A
        If .Cells(L, 1).Value = "7" Then
            Exit For
        Else
        'copie des lignes de la feuille 1 si cellule A n'est pas vide
            If .Cells(L, 1).Value <> "" Then
                .Rows(L).Copy Destination:=Worksheets("Tranche").Range("A7").Rows(lgDerLig2)
                lgDerLig2 = lgDerLig2 + 1
            End If
        End If
    Next L
End With
 
xlWbk1.Close
'sauvegarde du classeur de destination
'xlWbk2.Close True
xlApp.Quit
End Sub

[ANANA49]

Je pense avoir trouvé donc je vous transmets le code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
With xlWsh1
    'lecture du classeur source à parir de la ligne 1
    For L = 1 To lgDerlig1
        ' fin du traitement si valeur est trouvé en cellule A
        If .Cells(L, 1).Value = "7" Then
            Exit For
        Else
        'copie des lignes de la feuille 1 si cellule A n'est pas vide
            If .Cells(L, 1).Value <> "" Then
                .Rows(L).Copy Destination:=xlWsh2.Range("A7").Rows(lgDerLig2)
                lgDerLig2 = lgDerLig2 + 1
            End If
        End If
    Next L
 
      For L = 8 To lgDerlig1
        ' fin du traitement si valeur est trouvé en cellule A
        If .Cells(L, 1).Value = "6" Then
            Exit For
        Else
        'copie des lignes de la feuille 1 si cellule A n'est pas vide
            If .Cells(L, 1).Value <> "" Then
                .Rows(L).Copy Destination:=xlWsh2.Range("A16").Rows(lgDerLig2)
                lgDerLig2 = lgDerLig2 + 1
            End If
        End If
    Next L
End With