从不同工作簿复制数据的宏答案

【问题标题】：Macro to copy data from a different workbook从不同工作簿复制数据的宏
【发布时间】：2015-01-19 23:54:18
【问题描述】：

我有一个工作簿（Excel 2003 格式），其中的数据在三张纸中连续流动。我想在一个新工作簿（Excel 2010）中创建一个宏，其中前一个工作簿中所有三个工作表中的所有这些数据将一个接一个地粘贴到我的新工作簿的一个工作表中。我希望宏打开一个对话框来浏览实际存在数据的文件。谁能帮帮我？

在搜索时，我发现了如下所示的内容。但这不是我想要的。

Sub Open_Workbook()
Dim myFile As String 
    myFile = Application.GetOpenFilename _ 
            (Title:="Please choose a file to open", _ 
             FileFilter:="Excel Files .xls (.xls),") 
    If myFile = False Then 
        MsgBox "No file selected.", vbExclamation, "Sorry!" 
        Exit Sub 
    Else 
        Workbooks.Open Filename:=myFile 
    End If 
End Sub

【问题讨论】：

如果您展示到目前为止您尝试过的内容，我们更愿意？
在搜索时，我发现了如下所示的内容。但这不是我想要的。
Sub Open_Workbook() Dim myFile As String myFile = Application.GetOpenFilename _ (Title:="请选择要打开的文件", _ FileFilter:="Excel Files .xls (.xls),") If myFile = False Then MsgBox "No file selected.", vbExclamation, "Sorry!" Exit Sub Else Workbooks.Open Filename:=myFile End If End Sub
为了将来参考，您可以使用代码修改您的问题，而不是放在评论中。打开文件后，您将需要复制内容。您将数据具体放在哪里，从哪里来，就像在工作表名称中一样？另外，你知道这 3 张纸总是一样的吗？如果是这样，您不需要对话框来要求打开文件。这意味着，如果工作簿的名称中有某些内容，例如日期，或者与编译数据的主簿相匹配，您可以通过这种方式派生名称。

标签： vba excel

【解决方案1】：

我想这段代码会对你有所帮助

    Sub wb_sheets_combine_into_one()
    Dim sFileName$, UserName$, oWbname$, oWbname2$, sDSheet$ 'String type
    Dim nCountDestination&, nCount&, nCountCol& 'Long type
    Dim oSheet As Excel.Worksheet
    Dim oRange As Range
    Dim oFldialog As FileDialog
    Set oFldialog = Application.FileDialog(msoFileDialogFilePicker)

    With oFldialog
        If .Show = -1 Then
            .Title = "Select File"
            .AllowMultiSelect = False
            sFileName = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    'open source workbook
    Workbooks.Open sFileName:  oWbname = ActiveWorkbook.Name
    UserName = Environ("username")

    Workbooks.Add: ActiveWorkbook.SaveAs Filename:= _
                    "C:\Users\" & UserName & _
                    "\Desktop\Consolidated.xlsx", _
                    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    oWbname2 = ActiveWorkbook.Name
    sDSheet = ActiveSheet.Name
    nCountDestination = 1
    Workbooks(oWbname).Activate
    For Each oSheet In Workbooks(oWbname).Worksheets
        oSheet.Activate
        sDSheet = ActiveSheet.Name
        ActiveSheet.UsedRange.Copy
        For Each oRange In ActiveSheet.UsedRange
            nCountCol = oRange.Column
        Next
        Workbooks(oWbname2).Activate
        Cells(nCountDestination, 1).PasteSpecial xlPasteAll
        nCount = nCountDestination
        For Each oRange In ActiveSheet.UsedRange
            nCountDestination = oRange.Row + 1
        Next
        Range(Cells(nCount, nCountCol + 1), _
        Cells(nCountDestination - 1, nCountCol + 1)).Value = oSheet.Name
        Workbooks(oWbname).Activate
        With ActiveWorkbook.Sheets(sDSheet).Tab
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = 0
        End With
    Next
    Workbooks(oWbname2).Save: Workbooks(oWbname).Close False
    MsgBox "File with consolidated data from workbook " & Chr(10) & _
            "[ " & oWbname & " ] saved on your desktop!"
End Sub

【讨论】：