Перенесите именованную таблицу из рабочей книги в другую рабочую таблицу и скопируйте данные в одну таблицу

Question

Новичок в VBA, так что, надеюсь, я объясню это ясно ...

В итоге у меня будет 32 разных журнала, в которых есть таблица с именем DriverLog. Все они будут сохранены в MyDocuments !!! Transportation_Issues_Log !!! как файлы с поддержкой макросов, а затем один файл в той же папке с именем «MasterDriverLog». Что мне нужно, так это макроподключатель, который будет в каждом из 32 документов обновлять файл «MasterDriverLog» новыми данными. Столбец D или индекс 3 (таблица начинается в столбце B) - это номер инцидента, который будет уникальным для каждого документа. Идея заключается в том, что после экспорта удаляются дубликаты, что делает возможным только экспорт новых происшествий с драйверами.

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

Sub Copy_Paste_Below_Last_Cell()


'Find the last used row in both sheets and copy and paste data below existing data.

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

  'Set variables for copy and destination sheets
  Set wsCopy = Workbooks(sPS).Worksheets(1)
  Set wsDest = Workbooks("MasterDriverLog.xlsm").Worksheets(1)

  '1. Find last used row in the copy range based on data in column A
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row

  '2. Find first blank row in the destination range based on data in column A
  'Offset property moves down 1 row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

  '3. Copy & Paste Data
  wsCopy.Range("A2:D" & lCopyLastRow).Copy _
    wsDest.Range("A" & lDestLastRow)

  'Optional - Select the destination sheet
  wsDest.Activate

Кстати, объект книги копирования, на который я ссылаюсь, вызывает код модуля для сохранения файла (в котором находится макрос):

Sub SaveBook()
'----------------------------------------------------
'Save File to Hard Drive
'----------------------------------------------------

    Dim sFile As String
    Dim sPath As String
    Dim sPS As String

    sPS = Application.PathSeparator
    sPath = Environ("UserProfile") & sPS & "Documents" & sPS & "!!!Transportation_Issues_Log!!!" & sPS
    CreateDirectory sPath
    If Len(Dir(sPath, vbDirectory)) = 0 Then Exit Sub   'Couldn't create the path due to invalid or inaccessible location
    sFile = Range("G2").Value & "_DriverLog" & ".xlsm"

    ActiveWorkbook.SaveAs Filename:=sPath & sFile, FileFormat:=52

    MsgBox ("This has been saved as '") & sPath & sFile & ("' in your documents folder.  You may create a shortcut, but please do not move target location of file.")

End Sub

Sub CreateDirectory(ByVal arg_sFolderpath As String)

    If Len(Dir(arg_sFolderpath, vbDirectory)) = 0 Then
        Dim sPS As String
        sPS = Application.PathSeparator

        Dim sBuildPath As String
        Dim vFolder As Variant
        For Each vFolder In Split(arg_sFolderpath, sPS)
            If Len(vFolder) > 0 Then
                If Len(sBuildPath) = 0 Then sBuildPath = vFolder Else sBuildPath = sBuildPath & sPS & vFolder
                If Len(Dir(sBuildPath, vbDirectory)) = 0 Then
                    On Error Resume Next
                    MkDir sBuildPath
                    On Error GoTo 0
                    If Len(Dir(sBuildPath, vbDirectory)) = 0 Then
                        MsgBox "[" & sBuildPath & "] is either invalid or unreachable.", , "Create Directory Error"
                        Exit Sub
                    End If
                End If
            End If
        Next vFolder
    End If

End Sub