Discussion :

[DubDub]

Bonjour,

a force de patience et l'aide de ce forum je suis arriver a faire ce code qui fonctionne assez bien.

j'aimerais remplacer la ligne (le nom du fichier.xml)

Code :

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

1
2
3
With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;C:\Users\Eric\Desktop\Job\test3\sog7050.xml", Destination:=Range( _
        "A1"))

par le nom (sans le .xml) contenu de la cellule M7 puis refaire tout le code avec le nom dans la cellule n7 puis o7, p7 jusqu'a qu'il arrive a une cellule vide

voici le code au complet

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Sub OpenFileXLM()
'
' OpenFileXLM Macro
' Macro enregistrée le 2009-02-16 par duberi01
'
Dim a As Long
Dim b As Long
 
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;C:\Users\Eric\Desktop\Job\test3\sog7050.xml", Destination:=Range( _
        "A1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
 
    Columns("A:T").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:BL").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:A").EntireColumn.AutoFit
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
    Application.ScreenUpdating = False
 
    a = Range("A65536").End(xlUp).Row
 
    For b = a To 1 Step -1
        If Cells(b, 1) Like "*Mise*" Or Cells(b, 1) Like "*Correctif*" Or Cells(b, 1) Like "*Hotfix*" Or Cells(b, 1) Like "*Registry Name*" Then
        Rows(b).Delete
    End If
    Next b
 
    Application.ScreenUpdating = True
    ActiveSheet.Select
    SheetName = Range("Profils!M7")
    ActiveSheet.Name = SheetName
    ActiveSheet.Move After:=Sheets(Sheets.Count)
    Sheets("Profils").Select
    Range("M7").Select
 
End Sub

Merci j'apprend beaucoup avec le pas a pas dans le code.

[aalex_38]

Bonjour,

Si je comprend bien tu veux récupperer le nom dans une cellule et boucler en parcourant toutes les colonnes de la ligne 7 jusqu'a une cellule vide.

Il y a de nombreux exemples pour faire cela sur le forum.

Au lieu de

Code :

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

"FINDER;C:\Users\Eric\Desktop\Job\test3\sog7050.xml"

Tu peux faire quelque chose du style :

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
Dim Monchemin As String
Dim MonFichier As String
Dim MaPlage  As Range
Dim cellules As Range
Dim MonFinder As String
 
Monchemin = "C:\Users\Eric\Desktop\Job\test3\"
 
Set MaPlage = Range(Cells(7, 13), Cells(7, Range("IV7").End(xlToLeft).Column))
 
For Each cellules In MaPlage
 If cellules > "" Then
    MonFichier = cellules
    ' la tu remplaces "FINDER;C:\Users\Eric\Desktop\Job\test3\sog7050.xml" par
    MonFinder = "FINDER;" & Monchemin & MonFichier & ".xml"
    With ActiveSheet.QueryTables.Add(Connection:= _
        MonFinder, Destination:=Range("A1")) ' Pour la destination a toi de voir l
    End With
 
Next

Edit: Attention aux select faits avec l'enregistreur de macros, bien souvent ils sont inutiles et alourdissent le code.
Pourquoi faire :

Code :

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

1
2
Columns("A:T").Select
    Selection.Delete Shift:=xlToLeft

Quand tu peux faire tout simplement :

Code :

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

Columns("A:T").Delete Shift:=xlToLeft

[DubDub]

merci de m'avoir donner la syntax exacte

c'est trop genial, je n'ai peut-etre pas la bonne facon, mais j'apprend en recuperant du code et en l'adaptant, mais c'est vrai que je cherche parfois tres long temps.

si le coeur tant dit voici un bout de code qui fonctionne bien, mais prend plus de 3 a 4 minutes pour faire le menage dans 300 lignes environ

Code :

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

1
2
3
4
5
6
7
8
9
10
11
    Application.ScreenUpdating = False
 
    'a = Range("A65536").End(xlUp).Row
    'For b = a To 1 Step -1
        'If Cells(b, 1) Like "*Mise*" Or Cells(b, 1) Like "*Correctif*" Or Cells(b, 1) Like "*Hotfix*" Or Cells(b, 1) Like "*Registry Name*" Then
     '   If InStr(1, "Mise", "Correctif", 1) Then
      '  Rows(b).Delete
    'End If
    'Next b
 
    Application.ScreenUpdating = True

encore une fois un enorme merci

[aalex_38]

Regarde dans l'aide et dans le forum du coté de AUTOFILTER et SPECIALCELLS tu devrais trouver un moyen plus rapide !