2015-01-16 8 views
0

У меня есть рабочая книга (в формате Excel 2003), данные которой непрерывно текут в трех листах. Я хочу создать макрос в новой книге (Excel 2010), в которой все эти данные на всех трех листах предыдущей книги будут вставлены в один лист моей новой книги один за другим. Я бы предпочел, чтобы макрос открыл диалоговое окно для просмотра файла, где данные действительно присутствуют. Кто-нибудь может мне помочь?Macro для копирования данных из другой книги

При поиске я нашел что-то вроде приведенного ниже. Но это не тот, который я хочу точно.

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 
+0

И мы бы предпочли, если вы покажете, что вы пробовали до сих пор? – rusk

+0

При поиске я нашел что-то вроде приведенного ниже. Но это не тот, который я хочу точно. –

+0

Sub Open_Workbook() Dim Myfile As String \t Myfile = Application.GetOpenFilename _ \t (Title: = "Пожалуйста, выберите файл для открытия", _ \t FileFilter: = "Excel Files * .xls * (* .xls *), ") Если myFile = False Затем \t MsgBox" Файл не выбран. ", VbExclamation," Извините! " Exit Sub Else \t Workbooks.Open Имя файла: = Myfile End If End Sub –

ответ

0

Я полагаю, этот код поможет вам

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