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
CodePudding user response:
Is something like this what you are looking for?
Option Explicit
Sub test()
Dim sourceSheet As Worksheet, acctSheet As Worksheet
Dim i As Long
Dim sourceCell As Range, targetCell As Range, defaultCell As Range
Set defaultCell = sourceSheet.Cells(7, 1)
For i = 3 To 8
Set sourceCell = sourceSheet.Cells(14, i)
Set targetCell = acctSheet.Cells(i - 1, 11)
If IsEmpty(sourceCell) Then
targetCell.Value2 = sourceCell.Value2
ElseIf sourceCell.Value2 < defaultCell.Value2 Then
targetCell.Value2 = sourceCell.Value2
ElseIf sourceCell.Value2 > defaultCell.Value2 Then
targetCell.Value2 = defaultCell.Value2
End If
Next i
End Sub
Strictly speaking, I don't think you need to include .Value2
after every cell, as VBA kinda uses that as the default when reading the code, but it doesn't hurt.
Using variables for the cell references isn't strictly necessary either, but I find it easier, especially if I need to edit the cell references later.