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

Question

我有一个工作簿（Excel 2003 格式），数据在三个 sheet 秒内连续流动。我想在新工作簿 (Excel 2010) 中创建一个宏，其中所有三个 sheet 中的所有数据都将粘贴到我的单个 sheet 中新作业本，一本接一本。我更希望宏打开一个对话框来浏览实际存在数据的文件。谁能帮帮我？

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

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

Answer 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

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

Macro to copy data from a different workbook

excel

vba