用户选择（工作簿和工作表名称）然后复制和粘贴答案

【问题标题】：User Selection (workbook and sheet name) then Copy and Paste用户选择（工作簿和工作表名称）然后复制和粘贴
【发布时间】：2018-04-26 16:12:06
【问题描述】：

有没有办法让用户在打开文件后选择要复制的工作表？

我想这样做是因为可能有多个格式相同但名称不同的工作表。

示例：名为 VSC 的原始工作簿（包含工作表 Compare、Plot）

名为 SF 的辅助工作簿（包含工作表 Results1、Results2、Results3）

用户点击VSC上的按钮，打开文件对话框，用户在某个目录中选择SF，然后要求用户选择要从哪个表中选择-用户选择Results2 工作表，复制数据（范围“B2:B5”），然后将其粘贴回 Compare 工作表。

这可能吗？我不知道如何开始。

要求用户选择 SF 工作簿的当前代码：

Sub GetFilePath()
Dim objFSO as New FileSystemObject

Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
    .Title = "Choose File"
    .AllowMultiSelect = False
If .Show <> -1 Then
    Exit Sub
End If
FileSelected = .SelectedItems(1)
End With

【问题讨论】：

你是用宏打开SF还是在宏运行时已经打开？？
用户必须选择 SF 工作簿，我用文件对话框部分更新了我的帖子

标签： vba excel button

【解决方案1】：

这是一种方法。您输入工作表名称。调整复制和粘贴范围以适合。

Sub GetFilePath()

Dim objFSO As New FileSystemObject, w As String, wb As Workbook

Application.ScreenUpdating = False

Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
    .Title = "Choose File"
    .AllowMultiSelect = False
    If .Show <> -1 Then
        Exit Sub
    End If
    Set wb = Workbooks.Open(.SelectedItems(1))
End With

w = InputBox("Enter sheet name")

If SheetExists(w) Then
    wb.Sheets(w).Range("B2:B5").Copy
    ThisWorkbook.Sheets("Compare").Range("A1").pastespecial xlvalues
Else
    MsgBox "Sheet not found"
End If

wb.Close False

Application.ScreenUpdating = True

End Sub

Function SheetExists(s As String) As Boolean

Dim x    
On Error GoTo NextSheet
x = ActiveWorkbook.Sheets(SheetName).Name
SheetExists = True
Exit Function    
NextSheet:
    SheetExists = False    
End Function

【讨论】：

有没有关于复制和粘贴的论坛我可以看看？您提供的代码有效，但我只想要值，而不是粘贴格式
查找 pastespecial - 我已经修改了上面的代码。

【解决方案2】：

打开工作簿后，您可以按名称枚举工作表并在 VSC 工作簿中的工作表上填充选择列表...

【讨论】：

【解决方案3】：

这里有一个不同的方法来解决您的问题。打开新工作簿后，它使用计时器每隔 10 秒询问您是否在要从中复制的工作表上。如果您回答“是”，它将复制。如果您回答“否”，它将重新启动 10 秒计时器。

Sub GetFilePath()
    Set MyFile = Application.FileDialog(msoFileDialogOpen)
    With MyFile
        .Title = "Choose File"
        .AllowMultiSelect = False
        If .Show <> -1 Then
            Exit Sub
        End If
        FileSelected = .SelectedItems(1)
    End With
    Set newWk = Workbooks.Open(FileSelected, , True)
    'Open Selected Workbook and check in 10 seconds for Selected Sheet Name
    Application.OnTime Now + TimeValue("00:00:10"), "CheckForSheet"
End Sub
Private Sub CheckForSheet()
    Dim SheetName As String
    SheetName = ActiveSheet.Name
    answer = MsgBox("Is This the Sheet to copy from: " & SheetName & "?", vbYesNo + vbQuestion, "Copy Data?")
    If answer = vbYes Then
        'ThisWorkbook is the workbook with the Macro/VBA code
        'ActiveWorkbook is the workbook where you are selecting the Sheet to copy from
        ActiveWorkbook.Sheets(SheetName).Range("B2:B5").Copy
        ThisWorkbook.Sheets("Compare").Range("C1:C4").PasteSpecial
    Else
        'Check Again in 10 Seconds
        Application.OnTime Now + TimeValue("00:00:10"), "CheckForSheet"
    End If
End Sub

【讨论】：