VBA copier cellule X vers cellules Y avec condition
Avec :
ws.Cells(ligne, 1).Resize(dl - 7, 26).Value = wss.Range("$A$8:$Z$" & dl).Value
modifiée en :
ws.Cells(ligne, 1).Resize(dl - 7, 28).Value = wss.Range("$A$8:$Z$" & dl).Value
il m'a remplacer la valeur de la colonne 27 en #N/A (et la colonne 28 du coup)
Cela n'a rien changé pour les colonne de 1 à 26
Pour la colonne AC :
Je recherchai simplement a copier / coller les valeur de AC en AB, mais sans la formule SI associée du résultat de AC
En fait la colonne AC n'est qu'une formule reprenant le nom de l'auteur situé en A6
Re-,
Essaie avec ce code :
Sub CopierOIL()
Range("A11:AB64000").ClearContents 'effacement des données initiales
ligne = 11
Set ws = ThisWorkbook.ActiveSheet
Chemin = "C:\Users\brenaud\Desktop\EDU CAB TEST\DR EDU MLE\" 'Indiquer ici le chemin complet du dossier où se trouvent les fichiers sources
Fichier = Dir(Chemin & "*.xlsm") ' Premier fichier
Do While Fichier <> ""
Set wb = Workbooks.Open(Filename:=Chemin & Fichier)
Set wss = wb.Sheets("OIL")
dl = wss.Cells(Rows.Count, 1).End(xlUp).Row
ws.Cells(ligne, 1).Resize(dl - 7, 26).Value = wss.Range("$A$8:$Z$" & dl).Value
ws.Cells(ligne, "AA").Resize(dl - 7, 1) = Fichier
ws.Cells(ligne, "AB").Resize(dl - 7, 1) = ws.Range("A6").Value
wb.Close False
Application.CutCopyMode = False
ligne = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
Fichier = Dir ' Fichier suivant
Loop
With Range("AA11:AB64000").Font
.ColorIndex = xlAutomatic
.TintAndShade = 0 'colonne Y en couleur noire
End With
End SubPS, lorsque tu mets un code dans une réponse, pense à utiliser les balises </>
Ooohh trop bien !!!!!, tu me sauves la vie, depuis le temps que je galère là-dessus
Un grand merci à toi Cousinhub , trop top
Re-,
en essayant, je me suis rendu compte que ce n'était pas tout à fait ça...
Essaie avec ce code :
Option Explicit
Sub CopierOIL()
Dim Cel As Range
Dim DerLig As Long, DLig As Long
Dim Wb As Workbook
Dim Wss As Worksheet, Ws As Worksheet
Dim Chemin As String, Fichier As String
Application.ScreenUpdating = False
Range("A11:AB64000").ClearContents 'effacement des données initiales
DerLig = 11
Set Ws = ThisWorkbook.ActiveSheet
Chemin = "C:\Users\Hub bibi\Documents\Excel\Bernard59\source\"
'Chemin = "C:\Users\brenaud\Desktop\EDU CAB TEST\DR EDU MLE\" 'Indiquer ici le chemin complet du dossier où se trouvent les fichiers sources
Fichier = Dir(Chemin & "*.xlsm") ' Premier fichier
Do While Fichier <> ""
Set Wb = Workbooks.Open(Filename:=Chemin & Fichier)
Set Wss = Wb.Sheets("OIL")
DLig = Wss.Cells(Rows.Count, 1).End(xlUp).Row
Ws.Cells(DerLig, 1).Resize(DLig - 7, 26).Value = Wss.Range("$A$8:$Z$" & DLig).Value
Ws.Cells(DerLig, "AA").Resize(DLig - 7, 1) = Fichier
Wb.Close False
Application.CutCopyMode = False
DerLig = Ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
Fichier = Dir ' Fichier suivant
Loop
For Each Cel In Ws.Range("Z11:Z" & DerLig - 1)
If Cel = "OUI" Then Cel.Offset(, 2) = Ws.Range("A6").Value
Next Cel
With Range("AA11:AB" & DerLig).Font
.ColorIndex = xlAutomatic
.TintAndShade = 0 'colonne Y en couleur noire
End With
End SubNote que j'ai mis "Option Explicit" en haut du module, afin d'obliger à déclarer les variables (variables que j'ai également modifiées à ma sauce...
Et j'ai rajouté une boucle en fin de code, afin de satisfaire à la condition "Si Zxx= "Oui""........