Problème macro extraction de données Excel

[benadry]

Rebonjour,

Dans la suite du post de ce matin (https://www.excel-downloads.com/threads/probleme-macro-extraction-de-donnees-excel.208698/), j'ai de nouveau un problème dont la résolurtion me permettra de finaliser la macro.

Le fichier source alimente les colonnes A à W de la feuille cible si les conditions sont remplies.
Maintenant, je souhaite qu'après avoir rempi les colonnes A à W, la macro copie les colonnes AD à AJ de la ligne du dessus.

En plus clair (ce n'est pas évident à expliquer !) avec un exemple :
- les cellules A2023 à W2023 sont remplies préalablement (c'est le sens de l'exécution de la macro) à partir du fichier source ;
- alors, les cellules AD2023 à AJ2023 doivent être remplies à partir des cellules AD2022 à AJ2022 (c'est un copier-coller tout bête d'une ligne sur la ligne du dessous).

Voici mon code :

Sub ExtraireDonnees()

' Définition des constantes et des variables
Const FolderSource As String = "G:\CPT\...\Suivi des notifications d'indus\Journées\"
Const FolderCible As String = "G:\CPT\...\Suivi des notifications d'indus\"
Const FileNameCible As String = "Liste des indus créés à compter de 052013.xlsm"
Const SheetSource As String = "A"
Const SheetCible As String = "Total des indus non soldés"
Dim wkbSource, wkbCible As Workbook, shSource, shCible As Worksheet
Dim Lig As Long, nbrLig As Long, NumLig As Long
Dim Col As String, Ext As String, Nom As String

Nom = ThisWorkbook.Sheets(1).Range("G6").Value
Ext = ".xls"

Set wkbSource = Workbooks.Open(FolderSource & Nom & Ext)

' Renommer la 1ère feuille du fichier wkbSource en "A"
wkbSource.Sheets(1).Name = "A"

' Changement du format de la colonne R du fichier wbkSource
Columns("R:R").Select
Selection.NumberFormat = "0.00"
Range("R1").Select
Selection.NumberFormat = "General"

' Ouverture du fichier et de la feuille cibles : Total des indus non soldés de Liste des indus créés à compter de 052013.xlsm
Set wkbCible = Workbooks.Open(FolderCible & FileNameCible)
Set shCible = wkbCible.Worksheets("Total des indus non soldés")
Set shSource = wkbSource.Worksheets("A")

NumLig = 1

With shSource
nbrLig = .Range("R" & .Rows.Count).End(xlUp).row
nbrLig = .Range("W" & .Rows.Count).End(xlUp).row
For Lig = 2 To nbrLig
If .Cells(Lig, "R").Value <> 0 And .Cells(Lig, "V").Value <> "RLC" Then
.Range("A" & Lig & ":W" & Lig).Copy
Range("A65000").End(xlUp).Offset(1).Select
shCible.Paste
End If
Next
End With

With shCible
nbrLig = .Range("AD" & .Rows.Count).End(xlUp).row
nbrLig = .Range("AJ" & .Rows.Count).End(xlUp).row
For Lig = 2 To nbrLig
.Range("AD" & Lig & ":AJ" & Lig).Select
Selection.Copy
ActiveSheet.Paste
Next
End With

End Sub

Le problème est qu'avec ma syntaxe, la macro remonte à la ligne 2 et exécute sur les 2.000 lignes suivantes !

En fait, ce qu'il faudrait, c'est, je pense, remplacer dans :

With shCible
nbrLig = .Range("AD" & .Rows.Count).End(xlUp).row
nbrLig = .Range("AJ" & .Rows.Count).End(xlUp).row
For Lig = 2 To nbrLig
.Range("AD" & Lig & ":AJ" & Lig).Select
Selection.Copy
ActiveSheet.Paste
Next
End With

Ceci :

For Lig = 2 To nbrLig

par

For Lig = dernière ligne remplie To nbrLig

J'espère que j'ai été clair.

Merci d'avance pour votre aide.

Bien cordialement.

 

[kjin]

Re : Problème macro extraction de données Excel

Bonjour,
Avec le peu que je comprends...

Sub ExtraireDonnees()

' Définition des constantes et des variables
Const FolderSource$ = "G:\CPT\...\Suivi des notifications d'indus\Journées\"
Const FolderCible$ = "G:\CPT\...\Suivi des notifications d'indus\"
Const FileNameCible$ = "Liste des indus créés à compter de 052013.xlsm"
Const SheetSource$ = "A"
Const SheetCible$ = "Total des indus non soldés"
Dim wkbSource As Workbook, wkbCible As Workbook
Dim shCible As Worksheet
Dim Nom$, Ext$
Dim i&, j&, rng As Range

Nom = ThisWorkbook.Sheets(1).Range("G6").Value
Ext = ".xls"

Set wkbCible = Workbooks.Open(FolderCible & FileNameCible)
Set shCible = wkbCible.Worksheets(SheetCible)

Set wkbSource = Workbooks.Open(FolderSource & Nom & Ext)

With wkbSource
    'Renomme la 1ère feuille du fichier wkbSource en "A"
    .Sheets(1).Name = SheetSource
    With .Worksheets(SheetSource)
        'Changement du format de la colonne R du fichier wbkSource
        .Columns("R:R").NumberFormat = "0.00"
        .Range("R1").NumberFormat = "General"
        'Copie des données vers feuille cible
        For i = 2 To .Range("A65000").End(xlUp).Row + 1
            If .Cells(i, "R") <> 0 And .Cells(i, "V") <> "RLC" Then
                Set rng = .Range("A" & i & ":W" & i)
                With shCible
                    j = .Range("A65000").End(xlUp).Row + 1
                    .Range("A" & j & ":W" & j) = rng.Value
                    .Range("AD" & j & ":AJ" & j) = .Range("AD" & j & ":AJ" & j).Offset(-1).Value
                End With
            End If
        Next
    End With
End With
End Sub

A+
kjin