从当前工作簿复制数据并将其粘贴到另一个使用用户表单列表打开的工作簿

Question

我想要一个按钮打开一个用户表单，其中包含所有打开的工作簿的列表。用户选择他们想要的工作簿，代码从当前工作簿中的固定范围复制数据并将其粘贴到用户选择的工作簿中的固定范围内。

在四处搜索时，我发现了这段代码，它的工作原理类似，但从选定的工作簿复制并粘贴到当前工作簿中。

Option Explicit
Const PSWD = "atari"

Private Sub CancelButton_Click()
    Unload Me
End Sub
Private Sub CopyPasteButton_Click()

    ActiveSheet.Unprotect Password:=PSWD
    'This code will be executed when the "Copy" button is clicked on the userform.
    Dim wsData As Worksheet
    Dim rCopy As Range
    Dim CopyRw As Long

    Set wsData = ThisWorkbook.Sheets("SALES Details")

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = True

        With wsData
            .Unprotect PSWD
            CopyRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        End With

        On Error GoTo exit_err

        With Workbooks(Me.ListBox1.Value).Sheets("Master Sheet")
            Set rCopy = .Cells(10, 1).CurrentRegion
            Set rCopy = rCopy.Offset(1, 0).Resize(rCopy.Rows.Count - 1, 40)
            rCopy.Copy ThisWorkbook.Sheets("SALES Details").Cells(CopyRw, 1)
        End With

        Unload Me

exit_err:
        wsData.Protect Password:=PSWD
        .DisplayAlerts = True
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
End Sub

Private Sub UserForm_Activate()

'Populate list box with names of open workbooks, excluding main workbook.

    Dim wb As Workbook

    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then ListBox1.AddItem wb.Name
    Next wb

End Sub

这段代码很好用，因为它的作用。我一直在尝试编辑它，但没有运气。如何编辑它以反转方向并将其从当前工作表 (A50:J57) 中的固定范围复制到用户选择工作表 (A4:J11) 上的固定范围？

Answer 1

我认为这应该可行。当然，您必须在代码中调整工作表名称。

Private Sub CopyPasteButton_Click()
    Dim mySheet As Worksheet, otherSheet As Worksheet

    On Error GoTo exit_err

    Application.DisplayAlerts = False

    Set mySheet = ThisWorkbook.Sheets("SheetXYZ")
    Set otherSheet = Workbooks(Me.ListBox1.Value).Sheets("SheetABC")

    mySheet.Range("A50:J57").Copy Destination:=otherSheet.Range("A4:J11")

exit_err:
    Application.DisplayAlerts = True
End Sub

更新

要复制值而不是范围的公式，请使用此代码而不是 Copy 函数：

mySheet.Range("A50:J57").Copy 
otherSheet.Range("A4:J11").PasteSpecial xlPasteValuesAndNumberFormats

有关PasteSpecial 函数的更多选项，请参阅documentation。