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 Sub

PS, 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 Sub

Note 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""........

Rechercher des sujets similaires à "vba copier condition"