Как передать выделенные ячейки в Excel 2007 из одной таблицы в другую на одном листе?

Question

Я хотел бы создать код, который переносит содержимое выделенных ячеек из одной таблицы в другую на одном листе с содержимым, я использую кнопку для копирования содержимого, но мне бы хотелось создать макрос для переноса содержимого динамически, нажимая на кнопку, когда пользователь меняет содержимое выделенных ячеек первой таблицы, содержимое автоматически изменяется во второй таблице или снова нажимает кнопку.

Я использую этот код, чтобы выделить клетки

' Set of highlighted cells indexed by row number 
Dim highlightedCells As New Collection 

' Scan existing sheet for any cells coloured 'red' and initialise the 
' run-time collection of 'highlighted' cells. 
Private Sub Worksheet_Activate() 
    ActiveSheet.Unprotect Password:="P@ssw0rd" 
    Dim existingHighlights As Range 
    ' Reset the collection of highlighted cells ready to rebuild it 
    Set highlightedCells = New Collection 
    ' Find the first cell that has its background coloured red 
    Application.FindFormat.Interior.ColorIndex = 3 
    Set existingHighlights = ActiveSheet.Cells.Find("", _ 
                LookIn:=xlValues, _ 
                LookAt:=xlPart, _ 
                SearchOrder:=xlByRows, _ 
                SearchDirection:=xlNext, _ 
                MatchCase:=False, _ 
                SearchFormat:=True) 
    ' Process for as long as we have more matches 
    Do While Not existingHighlights Is Nothing 
     cRow = existingHighlights.Row 
     ' Add a reference only to the first coloured cell if multiple 
     ' exist in a single row (will only occur if background manually set) 
     Err.Clear 
     On Error Resume Next 
      Call highlightedCells.Add(existingHighlights.Address, CStr(cRow)) 
     On Error GoTo 0 
     ' Search from the cell after the last match. Note an error in Excel 
     ' appears to prevent the FindNext method from finding formats correctly 
     Application.FindFormat.Interior.ColorIndex = 3 
     Set existingHighlights = ActiveSheet.Cells.Find("", _ 
                After:=existingHighlights, _ 
                LookIn:=xlValues, _ 
                LookAt:=xlPart, _ 
                SearchOrder:=xlByRows, _ 
                SearchDirection:=xlNext, _ 
                MatchCase:=False, _ 
                SearchFormat:=True) 
     ' Abort the search if we've looped back to the top of the sheet 
     If (existingHighlights.Row < cRow) Then 
      Exit Do 
     End If 
    Loop 

ActiveSheet.Protect Password:="P@ssw0rd" 
End Sub 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    ActiveSheet.Unprotect Password:="P@ssw0rd" 
    Dim hCell As String 
    Dim cellAlreadyHighlighted As Boolean 
    hCell = "" 

    Err.Clear 
    On Error Resume Next 
     hCell = highlightedCells.Item(CStr(Target.Row)) 
    On Error GoTo 0 

    If (hCell <> "") Then 
     ActiveSheet.Range(hCell).Interior.ColorIndex = 2 
     If (hCell = Target.Address) Then 
      Call highlightedCells.Remove(CStr(Target.Row)) 
      Target.Interior.ColorIndex = 2 
     Else 
      Call highlightedCells.Remove(CStr(Target.Row)) 
      Call highlightedCells.Add(Target.Address, CStr(Target.Row)) 
      Target.Interior.ColorIndex = 3 
     End If 
    Else 
     Err.Clear 
     On Error Resume Next 
      highlightedCells.Remove (CStr(Target.Row)) 
     On Error GoTo 0 
     Call highlightedCells.Add(Target.Address, CStr(Target.Row)) 
     Target.Interior.ColorIndex = 3 
    End If 
    Cancel = True 
     ActiveSheet.Protect Password:="P@ssw0rd" 
End Sub 

И я использую этот код, чтобы скопировать выделенные клетки:

Sub CopyCat() 
    ActiveSheet.Unprotect Password:="P@ssw0rd" 
Dim LR As Long, i As Long, j As Long 
Dim c As Range 
j = 1 
LR = Range("A" & Rows.Count).End(xlUp).Row 
For Each c In Worksheets("MB").Range("A1:O" & LR) 
     If c.Interior.ColorIndex = 3 Then 
      c.Copy Destination:=Worksheets("MB").Range("J" & j) 
     j = j + 1 
     End If 
Next c 
    ActiveSheet.Protect Password:="P@ssw0rd" 

End Sub 

Пожалуйста, помогите !!!!

Answer 1

Вместо того, чтобы копировать всю таблицу и использовать значения для заполнения таблицы на второй странице, почему бы и нет (для тех элементов, которые вы хотите обновить, поскольку sheet1 получает обновления), просто оставьте «ссылку» обратно к оригиналу Таблица. Вы могли бы либо установить его буквально в ячейку, на которую он ссылается, или, более надежно, использовать что-то вроде Index/Match. См. Ниже:

Это пример Sheet1 (данные, которые вы хотите скопировать на второй лист). Я выделил столбец «Зарплата», чтобы отразить, что пользователю предлагается изменить его.

И на листе 2, вы можете использовать различные способы «ссылки» назад к первому листу:

Таким образом, когда вы идете в редактировании зарплата для Криса или Джона, он обновит свою зарплату во втором листе, без необходимости запускать какие-либо макросы. Это то, что вы хотите сделать, или я что-то не замечаю/не понимаю?