Importer sur la première ligne vide

Bonjour,

J'ai la macro suivante qui me permet d'importer des données de 3 onglets différents, d'un classeur fermé vers un autre classeur de T2 à V2 :

Sub Importer()

Dim FichierAouvrir As Variant, a, b, c, classeur As Workbook, i As Integer

Dim Derligne As Long

Dim Cell As Range

1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")

If FichierAouvrir = False Then Exit Sub

If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom

a = Array("6002-atelier") 'noms des feuilles, à adapter

b = Array("6000-atelier")

c = Array("6001-atelier")

Application.ScreenUpdating = False

On Error Resume Next 'sécurité, si une feuille n'existe pas

Set classeur = Workbooks.Open(FichierAouvrir)

With ThisWorkbook.ActiveSheet 'feuille à adapter

For i = 0 To UBound(a)

.Cells(i + 2, 20) = classeur.Sheets(a(i)).[E30] 'importe la valeur de la cellule E30

Next

For i = 0 To UBound(b)

.Cells(i + 2, 21) = classeur.Sheets(b(i)).[E30]

Next

For i = 0 To UBound(c)

.Cells(i + 2, 22) = classeur.Sheets(c(i)).[E30]

Next

End With

classeur.Close False 'referme le classeur

End Sub

Mon problème c'est que je souhaiterais ajouter des données juste en dessous en T3 U3 et V3 et ainsi de suite.

Je sais qu'il faut utiliser quelque chose comme Range("T65536").End(xlUp).Row + 1, mais j'ai beau essayer ça ne marche pas.

Je vous remercie par avance pour votre aide.

bonjour,

essaie ceci, j'ai gardé le +2 dans les cellules de destinations, mais selon moi cela n'est pas nécessaire.

Sub Importer()
 Dim FichierAouvrir As Variant, a, b, c, classeur As Workbook, i As Integer
 Dim Derligne As Long
 Dim Cell As Range

1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
 If FichierAouvrir = False Then Exit Sub
 If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
 a = Array("6002-atelier") 'noms des feuilles, à adapter
 b = Array("6000-atelier")
 c = Array("6001-atelier")

 Application.ScreenUpdating = False
 On Error Resume Next 'sécurité, si une feuille n'existe pas
 Set classeur = Workbooks.Open(FichierAouvrir)
 With ThisWorkbook.ActiveSheet 'feuille à adapter
 dl = .Cells(Rows.Count, "t").End(xlUp).Row + 1
 For i = 0 To UBound(a)
 .Cells(dl + i + 2, 20) = classeur.Sheets(a(i)).[E30] 'importe la valeur de la cellule E30
 Next
 For i = 0 To UBound(b)
 .Cells(dl + i + 2, 21) = classeur.Sheets(b(i)).[E30]
 Next
 For i = 0 To UBound(c)
 .Cells(dl + i + 2, 22) = classeur.Sheets(c(i)).[E30]
 Next

 End With
 classeur.Close False 'referme le classeur
 End Sub

Bonjour et merci

Mais ça ne fonctionne pas.

J'ai mis en pièce jointe les 2 fichiers, normalement si j'importe 4 fois ce même fichier je devrais avoir 4 fois les mêmes valeurs

Je pense que l'idée est dans ton code

h2so4 a écrit :

bonjour,

essaie ceci, j'ai gardé le +2 dans les cellules de destinations, mais selon moi cela n'est pas nécessaire.

Sub Importer()
 Dim FichierAouvrir As Variant, a, b, c, classeur As Workbook, i As Integer
 Dim Derligne As Long
 Dim Cell As Range

1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")
 If FichierAouvrir = False Then Exit Sub
 If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
 a = Array("6002-atelier") 'noms des feuilles, à adapter
 b = Array("6000-atelier")
 c = Array("6001-atelier")

 Application.ScreenUpdating = False
 On Error Resume Next 'sécurité, si une feuille n'existe pas
 Set classeur = Workbooks.Open(FichierAouvrir)
 With ThisWorkbook.ActiveSheet 'feuille à adapter
 dl = .Cells(Rows.Count, "t").End(xlUp).Row + 1
 For i = 0 To UBound(a)
 .Cells(dl + i + 2, 20) = classeur.Sheets(a(i)).[E30] 'importe la valeur de la cellule E30
 Next
 For i = 0 To UBound(b)
 .Cells(dl + i + 2, 21) = classeur.Sheets(b(i)).[E30]
 Next
 For i = 0 To UBound(c)
 .Cells(dl + i + 2, 22) = classeur.Sheets(c(i)).[E30]
 Next

 End With
 classeur.Close False 'referme le classeur
 End Sub

re-bonjour,

c'est quand même plus simple quand on a les fichiers

Sub Importer()
 Dim FichierAouvrir As Variant, a, b, c, classeur As Workbook, i As Integer
 Dim Derligne As Long
 Dim Cell As Range
 With ThisWorkbook.ActiveSheet 'feuille à adapter
1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")

  If FichierAouvrir = False Then Exit Sub
  If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom
  a = "6002-atelier" 'noms des feuilles, à adapter
  b = "6000-atelier"
  c = "6001-atelier"

  Application.ScreenUpdating = False
  On Error Resume Next 'sécurité, si une feuille n'existe pas
  Set classeur = Workbooks.Open(FichierAouvrir)
  dl = Application.WorksheetFunction.Max(.Cells(13, "u").End(xlUp).Row + 1, .Cells(13, "v").End(xlUp).Row + 1)
  dl = Application.WorksheetFunction.Max(dl, .Cells(13, "t").End(xlUp).Row + 1)
  .Cells(dl + i, 20) = classeur.Sheets(a).[E30]  'importe la valeur de la cellule E30
  .Cells(dl + i, 21) = classeur.Sheets(b).[E30]
  .Cells(dl + i, 22) = classeur.Sheets(c).[E30]
 End With
 classeur.Close False 'referme le classeur
 End Sub

Super, merci je vais tester.

J'avais réussi de cette manière aussi :

Sub Importer()

Dim FichierAouvrir As Variant, a, b, c, classeur As Workbook, derlig, i

1 FichierAouvrir = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*")

If FichierAouvrir = False Then Exit Sub

If Dir(FichierAouvrir) = ThisWorkbook.Name Then GoTo 1 'fichier de même nom

a = Array("6002-atelier") 'noms des feuilles, à adapter

b = Array("6001-atelier")

c = Array("6000-atelier")

Application.ScreenUpdating = False

On Error Resume Next 'sécurité, si une feuille n'existe pas

Set classeur = Workbooks.Open(FichierAouvrir)

derlig.Cells(Rows.Count, "t").End(xlUp).Row

With ThisWorkbook.ActiveSheet 'feuille à adapter

If .FilterMode Then .ShowAllData 'si la feuille est filtrée

derlig = .Cells(.Rows.Count, "T").End(xlUp).Row + 1

For i = 0 To UBound(a)

.Cells(derlig + i, "T") = classeur.Sheets(a(i)).[E30] 'importe la valeur de la cellule A1

Next

For i = 0 To UBound(b)

.Cells(derlig + i, "U") = classeur.Sheets(b(i)).[E30] 'importe la valeur de la cellule A1

Next

For i = 0 To UBound(c)

.Cells(derlig + i, "V") = classeur.Sheets(c(i)).[E30] 'importe la valeur de la cellule A1

Next

End With

classeur.Close False 'referme le classeur

End Sub