Aide macro VBA

Le 28/03/2017 à 16:15

Bonjour à nouveau,

Comme je ne trouve pas de solution à mon précédent poste, j'ai décidé de réfléchir autrement.

Si la feuille du fichier que je veux copier n'existe pas alors j'en veux en créer une jusque là tout va bien.

Par contre maintenant j'aimerais que le nom de la feuille qui s'est copié prenne le nom de la valeur en Range("N" & i).

Comment faire ?

Merci beaucoup,

Marion

Sub test()
Dim wkA As Workbook, wkB As Workbook
Dim chemin As String, fichier As String, i As Integer

'classeur A qui contient la macro
Set wkA = ThisWorkbook
With wkA.Sheets(1) 'les noms des classeurs à ouvrir se trouvent dans la feuille 1 en colonne N
'chemin ou se trouve le fichier B

chemin = "U:\Organic farming\Data\2_Validated\ORG\2015\"

'nom du fichier B
'fichier = "ORG_T1OPER_A_AT_2015.xlsx"

'ouvre le fichier B
For i = 1 To Sheets("Database old data").Range("N65536").End(xlUp).Row
If Dir(chemin & Sheets("Database old data").Range("N" & i) & ".xlsx") = "" Then
 Set shtoto = Sheets.Add(After:=Sheets(Sheets.Count))
 Sheets("Database old data").Select
 shtoto.Name = shtoto.Range("N" & i)

 Else

 Workbooks.Open chemin & Sheets("Database old data").Range("N" & i) & ".xlsx"
'met en variable le classeur B
Set wkB = ActiveWorkbook

'copie la feuille "DATA ENTRY" du classeur A après la feuille "Data new data" l dans le classeur B
wkB.Sheets("DATA ENTRY").Copy After:=wkA.Sheets("Data")
Set wsA = ActiveSheet
wsA.Name = wsA.Range("B2") 'référence ???

'MsgBox ("Les feuilles sont maintenant copiées") 'message pour dire que la feuille est copiée.

wkB.Close True 'ferme et enregistre le classeur B
End If
Next i
End With
'MsgBox ("Les feuilles sont maintenant copiées") 'message pour dire que la feuille est copiée.
End Sub
6time-series-org-t1oper-copy.xlsm (215.28 Ko)
Le 28/03/2017 à 22:48

Bonsoir,

Sub test()
    Dim wkS As Workbook, wsA As Worksheet, wsOD As Worksheet, chemin$, fichier$, i%, n%
    chemin = "U:\Organic farming\Data\2_Validated\ORG\2015\"
    With ThisWorkbook
        Set wsOD = .Sheets("Database old data")
        n = wsOD.Range("N" & .Rows.Count).End(xlUp).Row
        For i = 1 To n
            fichier = Dir(chemin & wsOD.Range("N" & i) & ".xlsx")
            If fichier = "" Then
                Set wsA = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
                wsA.Name = wsOD.Range("N" & i)
            Else
                Set wkS = Workbooks.Open(fichier)
                wkS.Worksheets("DATA ENTRY").Copy after:=.Worksheets(.Worksheets.Count)
                ActiveSheet.Name = wsOD.Range("N" & i)
                wkS.Close False
            End If
        Next i
    End With
End Sub

J'ai juste réécrit pour ôter les incohérences !

Les nommages de feuilles m'ayant parus flous... Je les nomme avec le nom du fichier source, ce n'est peut-être pas cela mais cela a le mérite d'être cohérent par rapport à ce qui préexistait.

Je n'ai pas regardé ton fichier...

NB- Je subodore qu'on doit y trouver du code pas mieux indenté que celui cité... et je m'en dispense ! Il faut prendre conscience que le code non indenté ou mal fait perdre un temps fou ! (et je trouve préférable de le perdre autrement ! )

Cordialement.

Le 29/03/2017 à 08:59
MFerrand a écrit :

Bonsoir,

Sub test()
    Dim wkS As Workbook, wsA As Worksheet, wsOD As Worksheet, chemin$, fichier$, i%, n%
    chemin = "U:\Organic farming\Data\2_Validated\ORG\2015\"
    With ThisWorkbook
        Set wsOD = .Sheets("Database old data")
        n = wsOD.Range("N" & .Rows.Count).End(xlUp).Row
        For i = 1 To n
            fichier = Dir(chemin & wsOD.Range("N" & i) & ".xlsx")
            If fichier = "" Then
                Set wsA = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
                wsA.Name = wsOD.Range("N" & i)
            Else
                Set wkS = Workbooks.Open(fichier)
                wkS.Worksheets("DATA ENTRY").Copy after:=.Worksheets(.Worksheets.Count)
                ActiveSheet.Name = wsOD.Range("N" & i)
                wkS.Close False
            End If
        Next i
    End With
End Sub

J'ai juste réécrit pour ôter les incohérences !

Les nommages de feuilles m'ayant parus flous... Je les nomme avec le nom du fichier source, ce n'est peut-être pas cela mais cela a le mérite d'être cohérent par rapport à ce qui préexistait.

Je n'ai pas regardé ton fichier...

NB- Je subodore qu'on doit y trouver du code pas mieux indenté que celui cité... et je m'en dispense ! Il faut prendre conscience que le code non indenté ou mal fait perdre un temps fou ! (et je trouve préférable de le perdre autrement ! )

Cordialement.

En gros avec le code là ca fonctionne:

Sub test()
Dim wkA As Workbook, wkB As Workbook
Dim chemin As String, fichier As String, i As Integer

'classeur A qui contient la macro
Set wkA = ThisWorkbook
With wkA.Sheets(1) 'les noms des classeurs à ouvrir se trouvent dans la feuille 1 en colonne N
'chemin ou se trouve le fichier B

chemin = "U:\Organic farming\Data\2_Validated\ORG\2015\"

'nom du fichier B
'fichier = "ORG_T1OPER_A_AT_2015.xlsx"

'ouvre le fichier B
For i = 1 To Sheets("Database old data").Range("N65536").End(xlUp).Row
If Dir(chemin & Sheets("Database old data").Range("N" & i) & ".xlsx") = "" Then
 Set shtoto = Sheets.Add(After:=Sheets(Sheets.Count))

 shtoto.Name = Sheets("Database old data").Range("N" & i)

 Else

 Workbooks.Open chemin & Sheets("Database old data").Range("N" & i) & ".xlsx"
'met en variable le classeur B
Set wkB = ActiveWorkbook

'copie la feuille "DATA ENTRY" du classeur A après la feuille "Data new data" l dans le classeur B
wkB.Sheets("DATA ENTRY").Copy After:=wkA.Sheets("Data")
Set wsA = ActiveSheet
wsA.Name = wsA.Range("B2") 'référence ???

'MsgBox ("Les feuilles sont maintenant copiées") 'message pour dire que la feuille est copiée.

wkB.Close True 'ferme et enregistre le classeur B
End If
Next i
End With
'MsgBox ("Les feuilles sont maintenant copiées") 'message pour dire que la feuille est copiée.
End Sub

Néamoins merci beaucoup à vous Je n'aurai pas trouvé sans vous ou était mon erreur !

Rechercher des sujets similaires à "aide macro vba"