Создание копии данных из 12 рабочих книг в один мастер Excel 2013

Question

В настоящее время у меня есть 12 пользователей, которые используют разные книги для сопоставления данных.

Я хочу, чтобы данные каждого пользователя автоматически обновлялись до мастер-листа в другой книге.

Я пытался создать 12 подключений к каждой книге, а затем импортировать данные в таблицу, но это блокирует рабочие книги пользователя до тех пор, пока основная книга не будет закрыта.

Может кто-то указать мне на правонаправление, я должен использовать VBA или PowerQuery?Любая помощь будет оценена :) 1007 *

Answer 1

@ Клин, спасибо большое.Я использовал Power Query и работал очень хорошо.

Answer 2

Вы можете попробовать это:

Sub GetData()
Dim MySheet As Worksheet
Dim wbCnt As Workbook
Dim DataSheet As Worksheet
Dim Folder As String
Dim SorceFile As String
Dim FileFlag As Integer

Set MySheet = ActiveSheet
'..... set your files path in local or remote system
'..... You can use array
Folder = Environ("userprofile") & "\Desktop\"
SorceFile = Dir(Folder)
While SorceFile <> ""
    If Right(sourcefile, 4) = "xlsx" Or Right(sourcefile, 4) = ".xls" Then
        FileFlag = GetFileIndex(sourcefile)
        If FileFlag = -1 Then
            Set wbCnt = Workbooks.Open(SorceFile)
        Else
            wbCnt = Workbooks(FileFlag)
        enif

        '..... select your sheet .......
        Set DataSheet = wbCnt.Sheets(1)
        '.... Copy data from source to your master sheet

        If FileFlag = -1 Then
            wbCnt.Close
        End If
    End If
    SorceFile = Dir
Wend
End Sub

Function GetFileIndex(ByVal FileName As String) As Integer
Dim FileNum As Integer, ErrNum As Integer
Dim Cnt As Integer
On Error Resume Next
FileNum = FreeFile()
Open FileName For Input Lock Read As #FileNum
Close FileNum
ErrNum = Err
On Error GoTo 0
Select Case ErrNum
    Case 0
        '.... File is not open
        GetFileIndex = -1
    Case 70
        For Cnt = 1 To Workbooks.Count
            If Workbooks(Cnt).Name = FileName Then
                GetFileIndex = Cnt
                Exit Function
            End If
        Next
    Case Else
        Error ErrNum
End Select
End Function