CopyFields_FromTo

Sub Edgar_CopyFields_FromTo_Batch()
    ' Move (or Copy) certain field, from Section to Section
    ' As batch
    ' I5 No of employees From Sec3 to Sec1
    ' EF5 | EF6 | EF23 | EF30 | EF31 | EF34 | HJ60
    ' From Sec3 to Sec2
    '
   
    CellsArr = ""
'    CellsArr = "I5" '                                                    Move from Sec3 to Sec1
'    CellsArr = "E5|F5|H60|J60" '                                    Move from Sec3 to Sec2
    CellsArr = "E6|F6|E23|F23|E30|F30|E31|F31|E34|F34" '    Copy from Sec3 to Sec2
    C1M2 = 1 '                                                            1 for copy, 2 to move
    SecFrom = 3
    SecTo = 2
    If CellsArr = "" Then Exit Sub
   
    Application.Calculation = xlCalculationManual
    For Each Cell1 In Split(CellsArr, "|")
        Cell1 = Trim(Cell1)
        Edgar_CopyMoveText_FromTo Cell1, SecFrom, SecTo, C1M2
    Next
    Application.Calculation = xlCalculationAutomatic
   
End Sub


Sub Edgar_CopyMoveText_FromTo(FieldCell, FromSecID, ToSecID, Optional Copy1_or_Move2 = 2)
    '
    ' Move certain field, from Section to Section
    '
    ToSecRow = 0
    NRows = ShNotes.Range("A1").CurrentRegion.Rows.Count
    X1 = 2
    Do Until X1 > NRows
        CompName = ShNotes.Range("A" & X1).Value
        CompNoteID = Val(ShNotes.Range("B" & X1).Value)
        If CompName = "" Then GoTo NextNRow
        HaveNotes = WorksheetFunction.CountA(ShNotes.Range("D" & X1, "AZ" & X1))
        If HaveNotes = 0 Then GoTo NextNRow
       
        If ToSecRow = 0 Or CompNoteID = 1 Then ToSecRow = X1
        ToSecHead = ShNotes.Range("D1").Offset(, (ToSecID - 1) * 2).Value
        ToSec = ShNotes.Range("D" & ToSecRow).Offset(, (ToSecID - 1) * 2).Value
       
        FromSecHead = ShNotes.Range("D1").Offset(, (FromSecID - 1) * 2).Value
        FromSec = ShNotes.Range("D" & X1).Offset(, (FromSecID - 1) * 2).Value
       
        HaveField = VBInstr(FieldCell & "=", FromSec)
        If HaveField = 0 Then GoTo NextNRow
       
        FieldRule = Mid(FromSec, HaveField)
        FieldRule = CutString(FieldRule, , "{$F$}")
        If FieldRule = FromSec Then GoTo NextNRow
       
        ToSec = ToSec & IIf(ToSec > "", "{$F$}", "") & FieldRule
       
        If Copy1_or_Move2 = 2 Then
            FromSec = Replace(FromSec, FieldRule, "")
            FromSec = Replace(FromSec, "{$F$}{$F$}{$F$}", "{$F$}") ' possible duplication generated by replace above
            FromSec = Replace(FromSec, "{$F$}{$F$}", "{$F$}") ' possible duplication generated by replace above
           
            If Left(FromSec, 5) = "{$F$}" Then FromSec = Mid(FromSec, 6)
            If Right(FromSec, 5) = "{$F$}" Then FromSec = Left(FromSec, Len(FromSec) - 5)
           
            ShNotes.Range("D" & X1).Offset(, (FromSecID - 1) * 2).Value = FromSec
        End If
       
        ShNotes.Range("D" & ToSecRow).Offset(, (ToSecID - 1) * 2).Value = ToSec
        ToSecRow = 0
NextNRow:
        X1 = X1 + 1
        DoEvents
    Loop
End Sub