1
votes

Comment copier-coller des données basées sur certains critères d'un classeur à un autre (cellules spécifiques) à l'aide de VBA?

J'ai écrit ci-dessous le code pour copier les données d'un classeur vers des cellules spécifiques d'un autre classeur (c'est un défi, je pense, le fichier de destination contient des mois et des données pertinentes en dessous, chaque mois, je dois copier les données dans la colonne du mois en cours , c'est pourquoi on a utilisé la fonction "dernière colonne" pour ne pas écraser les mois historiques aussi pour le rendre dynamique pour aller à la dernière colonne où il n'y a pas de données quel mois en cours). Même si le code fonctionne bien, je veux l'optimiser pour déboguer facilement et éviter les problèmes futurs quand par ex; l'année en cours a changé. Avez-vous des idées pour améliorer ce code ?

Code

Dim  x, LastRow, LastColumn, workfile, sourcefile As String
 
 sourcefile = ActiveWorkbook.Name
 workfile = ThisWorkbook.Name


LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(28, 21).End(xlToLeft).Column + 1 
    Workbooks(workfile).Worksheets("A").Cells(28, Lastcolumn2).PasteSpecial xlPasteValues
Else

End If

If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn3 = Workbooks(workfile).Worksheets("A").Cells(29, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(29, Lastcolumn3).PasteSpecial xlPasteValues
Else
End If

If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn4 = Workbooks(workfile).Worksheets("A").Cells(35, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(35, Lastcolumn4).PasteSpecial xlPasteValues
    Else
    End If
    
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn5 = Workbooks(workfile).Worksheets("A").Cells(36, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(36, Lastcolumn5).PasteSpecial xlPasteValues
    Else
    End If
    Next

excel vba if-statement loops copy-paste

1 commentaires

Cette question convient peut-être mieux à la révision de code .

3 Réponses :

0
votes

Tout ce que vous avez à faire est de déterminer quelle est la ligne cible pour chacune de vos conditions, puis branchez simplement cette valeur dans le bloc de code que vous souhaitez exécuter. De cette façon, vous évitez d'avoir le même code répété plusieurs fois.

Voici comment procéder:

Dim  x, LastRow, LastColumn, workfile, sourcefile, exchangedownload1, exchangedownload2 As String
Dim targetRow As Integer

sourcefile = ActiveWorkbook.Name
workfile = ThisWorkbook.Name

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1

    ' store the values you are wanting to examine in these 2 variables
    exchangedownload1 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value
    exchangedownload2 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value

    ' determine the value for targetRow in this Case statement
    Select Case exchangedownload2
        Case Is "GBP"
            If exchangedownload1 = "001B" Then
                targetRow = 28
            ElseIf enchangedownload1 = "001R" Then
                targetRow = 29
        Case Is "EUR"
            If exchangedownload1 = "001B" Then
                targetRow = 35
            ElseIf enchangedownload1 = "001R" Then
                targetRow = 36
    End Select

    ' this is your code block that was being repeated with just a 
    ' different value for your targetRow, so just plug the value for 
    ' targetRow where it belongs and you only have to have this code block once
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetRow, 21).End(xlToLeft).Column + 1 
    Workbooks(workfile).Worksheets("A").Cells(targetRow, Lastcolumn2).PasteSpecial xlPasteValues

Next

3 commentaires

'déterminer la valeur de targetRow dans cette instruction Case Select Case xrate2 Case Is = GBP Si xrate1 = "001B" Then targetrow = 28 ElseIf xrate1 = "001R" Then targetrow = 29 Select Case xrate2 Case Is = EUR Si xrate1 = "001B" Then targetrow = 35 ElseIf xrate1 = "001R" Then targetrow = 36 End Select "Cette partie n'a pas fonctionné comme elle le dit Erreur de compilation: Fin de la sélection sans Select Case.

@NigarHuseynzade Je ne comprends pas votre commentaire, qu'est-ce que vous essayez de communiquer? avez-vous une question sur ma réponse ou rencontrez-vous des problèmes pour la mettre en œuvre?

Désolé peut-être que je n'étais pas clair, j'ai des problèmes lors de la mise en œuvre du code ci-dessus que vous avez écrit qu'il montrait une erreur et je l'ai changé un peu mais ne fonctionnait toujours pas.

0
votes

Voici donc la capture d'écran du "fichier de travail" où je dois copier les données chaque mois dans la colonne du mois correspondant. Le taux d'impact de la zone de changement ne contient que des formules et des calculs. Donc copié est avant ça: colonnes vides actuellement à partir d'août, bcoz je l'ai déjà couru pour le juillet, comme je l'ai dit ça marche mais le code semble trop complexe et difficile à déboguer pour une autre personne

0 commentaires

0
votes

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
    ' store the values you are wanting to examine in these 2 variables
    xrate1 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value
    xrate2 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value

    ' determine the value for targetRow in this Case statement
    Select Case xrate2
        Case "GBP"
    Select Case xrate1
        Case "001B": targetrow = 28
    Case Else: targetrow = 29
    End Select
    Select Case xrate2
        Case "EUR"
    Select Case xrate1
        Case "001B": targetrow = 35
     Case Else: targetrow = 36
    End Select

    ' copying data
    Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
    Workbooks(workfile).Worksheets("A").Activate
    Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetrow, 21).End(xlToLeft).Column + 1
    Workbooks(workfile).Worksheets("A").Cells(targetrow, Lastcolumn2).PasteSpecial xlPasteValues
Next
Above is the adjusted one as I couldn't use If statement with Case, Case is replacement of If, Elseif. But still receiving compile error saying it is "Next without For" and End Select without Case statement((

0 commentaires