Question

我有一个工作簿（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

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

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

1 个答案: