mercredi 24 novembre 2021

please help me to create a loop for this vba code

I have 2 sheets,sourcesheet and acct sheet. From sourceSheet I need to copy the values from sourceSheet.Range(Cells(14, 3),Cells(14, 8)) to AcctSheet.range(Cells(2, 11),Cells(7, 11)), however is each cell from sourcesheet is distinct matched to acctsheet, in such a way that

sourceSheet.Cells(14, 3) = AcctSheet.Cells(2, 11)
sourceSheet.Cells(14, 4) = AcctSheet.Cells(3, 11)
sourceSheet.Cells(14, 5) = AcctSheet.Cells(4, 11) and so on until
sourceSheet.Cells(14, 8) = AcctSheet.Cells(7, 11)

full code is here, but hoping to loop this one.

sourceSheet.Activate
    'EQ
    If IsEmpty(sourceSheet.Cells(14, 3).Value) Then
        AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 3).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(14, 3).Value 
    ElseIf sourceSheet.Cells(14, 3).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'WS
    If IsEmpty(sourceSheet.Cells(14, 4).Value) Then
        AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 4).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(14, 4).Value 
    ElseIf sourceSheet.Cells(14, 4).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'TO
    If IsEmpty(sourceSheet.Cells(14, 5).Value) Then
        AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 5).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(14, 5).Value 
    ElseIf sourceSheet.Cells(14, 5).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'FL
    If IsEmpty(sourceSheet.Cells(14, 6).Value) Then
        AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 6).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(14, 6).Value 
    ElseIf sourceSheet.Cells(14, 6).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'FR
    If IsEmpty(sourceSheet.Cells(14, 7).Value) Then
        AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 7).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(14, 7).Value 
    ElseIf sourceSheet.Cells(14, 7).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'TR
    If IsEmpty(sourceSheet.Cells(14, 8).Value) Then
        AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 8).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(14, 8).Value 
    ElseIf sourceSheet.Cells(14, 8).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If

Aucun commentaire:

Enregistrer un commentaire