Discussion :

[lafafmentvotre]

Bonjour

Je rencontre un petit dilemme sur Excel.
J'ai un export AS400 au format xls (pas de possibilité d'écrire en xlsx).
Le nombre de lignes étant assez conséquent, il me créé dans ce fichier plusieurs onglets de 65536 lignes avec en première ligne les libellés propre à mon export (titre des colonnes)

Je cherche une possibilité via VBA de :
- Analyser ce fichier d'export XLS afin de savoir combien d'onglets sont créés
- de copier le contenu de chaque onglet du fichier XLS
- de coller ce contenu dans un fichier XLSX en ne mettant que la ligne de libellés 1 fois tout en haut (sans reprendre à chaque copie la ligne de libellé des onglets suivants sinon il y aura dans l'onglet du fichier xlsx en 65537 une ligne de libellé et ainsi de suite)

Est-ce possible ?
J'espère avoir été clair, pas évident d'expliquer mon besoin

Merci par avance pour vos réponses

[mercatog]

J'ai pas testé avec 65536 lignes mais ci-joint code
(Code à mettre dans un fichier tiers qui permet d'ouvrir le fichier issu d'AS400 et de créer un nouveau fichier xlsx nommé BD)

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
Sub Transfert()
Dim LastLig As Long, NewLig As Long
Dim Suivants As Boolean
Dim Fichier As Variant
Dim Wbks As Workbook
Dim Ws As Worksheet
 
Application.ScreenUpdating = False
Fichier = Application.GetOpenFilename("Excel Files (*.xls), *.xls", , "Ouvrir le fichier xls issu de l'AS400")
If Fichier <> False Then
    Set Wbks = Workbooks.Open(Fichier)
    With Workbooks.Add(1)
        With .Worksheets(1)
            For Each Ws In Wbks.Worksheets
                If Not Suivants Then
                    Ws.Rows(1).Copy .Range("A1")
                    NewLig = 2
                Else
                    NewLig = NewLig + LastLig - 1
                End If
                If NewLig <= .Rows.Count Then
                    LastLig = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row
                    If LastLig = 1 Then LastLig = Ws.Rows.Count
                    Ws.Rows("2:" & LastLig).Copy .Range("A" & NewLig)
                    Suivants = True
                Else
                    Suivants = False             'réutilisée pour savoir si le feuille xlsx a inclue toutes les données
                End If
            Next Ws
        End With
        Application.DisplayAlerts = False
        .SaveAs Filename:=Wbks.Path & "\BD", FileFormat:=xlOpenXMLWorkbook
        Application.DisplayAlerts = False
        .Close
    End With
    Wbks.Close False
    Set Wbks = Nothing
    MsgBox "Traitement terminé " & IIf(Suivants, "avec succès", "partiellement")
End If
End Sub

[lafafmentvotre]

Super cela fonctionne.

Merci beaucoup