首页 文章

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

提问于
浏览 次
0

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

在搜索时我找到了这个代码，它的工作方式类似，但是从选定的工作簿中复制并粘贴到当前的工作簿中 .

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）上的固定范围？

excel excel-vba vba

1 回答

  • 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

    UPDATE

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

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

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

    回复于

相关问题