Nouveau sujet VBA
Hello !
Je souhaite récupérer les colonnes 4,5,13,21 de plusieurs fichiers avec des chiffres différents mais organisés de la même manière (un fichier par jour) contenus dans un dossier. Pour ces 4 colonnes je souhaite récupérer toutes les lignes de 33 à 56 inclus. Quand j'exécute mon code ci-dessous, il me récupère toutes les colonnes au lieu des 4 indiqués. Et je ne sais pas comment sélectionner que les lignes. Si quelqu'un pouvait m'envoyer un code corrigé ça serait super sympa
Merci !
Sub ParcourirEtCopier()
Dim Chemin As String, Fichier As String, NomFichierCible As String, NomFichierSource As String
Dim LastLigne As Integer, NumColonne As Integer, i As Integer, j As Integer
NomFichierCible = ActiveWorkbook.Name 'correspond au fichier destinataire des données
Chemin = "où se trouve mes fichiers\"
'----------------------------------------------------
'Boucle sur tous les fichiers xls du répertoire
'---------------------------------------------------
Fichier = Dir(Chemin & "*.xls")
j = 1
Do While Len(Fichier) > 0
Workbooks.Open Filename:=Chemin & Fichier
NomFichierSource = ActiveWorkbook.Name
Sheets("Fichier Back-Office").Select 'selectionne l'onglet dans lequel se trouve les données
LastLigne = Range("A75").End(xlUp).Row 'trouve la dernière ligne de la 1ere colonne en considérant que dans un même classeur, toutes les colonnes ont le même nombre de lignes
For i = 1 To 4 'permet de choisir les colonnes à copier'
Select Case i
Case 1
NumColonne = 4
Case 2
NumColonne = 5
Case 3
NumColonne = 13
Case 4
NumColonne = 21
End Select
Range(Cells(1, NumColonne), Cells(LastLigne, NumColonne)).Select 'sélectionne la colonne
Selection.Copy
Windows(NomFichierCible).Activate
Cells(j, i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'colle les valeurs
Windows(NomFichierSource).Activate
Next i
j = j + LastLigne
ActiveWorkbook.Close (False) 'ferme le classeur sans le sauver
Fichier = Dir() 'récupére le nom du prochain fichier
Loop
End SubBonjour,
il serait préférable de joindre un fichier comportant
- en feuille 1 : Une feuille "Fichier Back-Office"
- en feuille 2 : Le résultat à obtenir
Parce que tu parles des lignes 33 à 56, mais on ne voit rien de ça dans ton code.
Comme il n'y aura qu'une seule feuille backoffice, merci d'indiquer sur la feuille2 (cible) ou seront récupérées les autres données des backoffice...
Merci
Sinon voici un premier essai en aveugle dans ma boule de cristal...
Sub CopierCollerValue()
Dim WBS As Workbook, WsS As Worksheet, WsC As Worksheet
Dim iR&, iLRS&, Chemin$, Fichier$, Arr
Set WsC = ThisWorkbook.ActiveSheet
Chemin = "où se trouve mes fichiers\"
Fichier = Dir(Chemin & "*.xls")
iR = 1
Do While Len(Fichier) > 0
Set WBS = Workbooks.Open(Chemin & Fichier, ReadOnly:=True)
Set WsS = WBS.Workheets("Fichier Back-Office")
iLRS = WsS.Range("A75").End(xlUp).Row
With ThisWorkbook.ActiveSheet
Arr = WsS.Range("D1:D" & iLRS).Value
.Cells(iR, 4).Resize(UBound(Arr), 1) = Arr
Arr = WsS.Range("E1:E" & iLRS).Value
.Cells(iR, 5).Resize(UBound(Arr), 1) = Arr
Arr = WsS.Range("M1:M" & iLRS).Value
.Cells(iR, 13).Resize(UBound(Arr), 1) = Arr
Arr = WsS.Range("U1:U" & iLRS).Value
.Cells(iR, 21).Resize(UBound(Arr), 1) = Arr
End With
iR = iR + iLRS
WBS.Close (False) 'ferme le classeur sans le sauver
Fichier = Dir() 'récupére le nom du prochain fichier
Loop
End SubA+
Le plus facile, si ta version d'Excel le permet, c'est d'utiliser Power Query qui fait ça très facilement sans programmation.
