VBA для вставки данных в существующую книгу без указания имени книги?

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

Для создания ежемесячных отчетов данные экспортируются с сервера в файл.xlsx с именем даты / времени экспорта отчета. Поэтому имя рабочей книги, в которую будет вставлена ​​информация, всегда будет иметь разные названия. Столбцы, в которых информация в ежемесячном экспорте данных всегда будет оставаться неизменной (столбцы D:G & I). Мне удалось сделать это для двух указанных рабочих книг, но я не могу перенести их в новый ежемесячный экспорт данных.

    Range("I4").Select
Windows("Export 2018-06-21 11.51.34.xlsx").Activate
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=9, Criteria1:= _
    xlFilterLastMonth, Operator:=xlFilterDynamic
Range("D2:G830,I2:I830").Select
Range("I2").Activate
Selection.Copy
Windows("ReportWorkbookTest.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

Есть ли способ настроить VBA, чтобы при запуске макроса не нужно было указывать имена книг? Кроме того, как мне указать, что макрос копирует только активные строки в таблицу, если количество строк изменяется на экспорт?

Спасибо!

2 ответа

Это ваша структура, если у вас есть несколько файлов для импорта, я бы предложил вместо этого мастера.

Структура мастера будет: 1) предлагать пользователю выбрать файл (определенного типа, который вы можете проверить, может быть именем столбца - заголовок) 2) если он проходит проверку, затем импортировать данные (и обработать их) 2b) если не передает отчет, это не был действительный файл и снова запрашивает 3) запрос на следующий тип файла......

У меня есть проект, подобный этому, который берет 4 разных "дампов" данных и ежемесячно объединяет их в сводную рабочую книгу.

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

Option Explicit

'Sub to get the Current FileName
Private Sub getFN()

    Dim Finfo As String
    Dim FilterIndex As Long
    Dim Title As String

    Dim CopyBook As Workbook    'Workbook to copy from
    Dim CopySheet As Worksheet  'Worksheet to copy from
    Dim FN As Variant           'File Name
    Dim wsNum As Double         'worksheet # as you move through the Copy Book
    Dim cwsLastRow As Long      'copy worksheet last row
    Dim mwsLastRow As Long      'master worksheet last row
    Dim masterWS As Worksheet   'thisworkbook, your master worksheet

    Dim rngCopy1 As Range
    Dim rngCopy2 As Range

    Set masterWS = ThisWorkbook.Worksheets("Master Security Logs")

    'Set up file filter
    Finfo = "Excel Files (*.xls*),*.xls*"
    'Set filter index to Excel Files by default in case more are added
    FilterIndex = 1
    ' set Caption for dialogue box
    Title = "Select the Current AP Reconcile Workbook"

    'get the Forecast Filename
    FN = Application.GetOpenFilename(Finfo, FilterIndex, Title)

    'Handle file Selection
    If FN = False Then
        MsgBox "No file was selected.", vbExclamation, "Not so fast"
    Else
        'Do your Macro tasks here
        'Supress Screen Updating but don't so this until you know your code runs well
        Application.ScreenUpdating = False

        'Open the File
        Workbooks.Open (FN)
        'Hide the file so it is out of the way
        Set CopyBook = ActiveWorkbook

        For wsNum = 1 To CopyBook.Sheets.Count 'you stated there will be 8, this is safer
            'Do your work here, looks like you are copying certain ranges from each sheet into ThisWorkbook
            CopySheet = CopyBook.Worksheets(wsNum) '1,2,3,4,5,6,7,8

            'Finds the lastRow in your Copysheet each time through
            cwsLastRow = CopySheet.Cells(CopySheet.Rows.Count, "A").End(xlUp).Row

            'Set your copy ranges
            Set rngCopy1 = CopySheet("D2:D"&cwsLastRow) 'this is your D column
            Set rngCopy2 = CopySheet("I2:I"&cwsLastRow) 'this is your I column

            'so you would have to keep tabs on what the lastRow of this sheet is too and always start at +1
            mwsLastRow = masterWS.Cells(masterWS.Rows.Count, "A").End(xlUp).Row

            'Copy the ranges in where you want them on the master sheet
            'rngCopy1.Copy destination:= masterWS.Range("D"&mwsLastRow+1)
            'rngCopy2.Copy destination:= masterWS.Range("I"&mwsLastRow+1)

            'Clear the clipboard before you go around again
            Application.CutCopyMode = False
        Next wsNum
    End If

    'Close the workbook opened for the copy
    CopyBook.Close savechanges:=False 'Not needed now

    'Screen Updating Back on
    Application.ScreenUpdating = True

End Sub

Если будут открыты только эти две рабочие книги, вместо имени можно использовать цифры:

Workbooks(1)
and
Workbooks(2) 

Рабочие книги (1) будут открываться первыми, скорее всего ReportWorkbookTest.xlsm, где будет находиться макрос, так что вы можете предоставить инструкции, что этот файл должен быть открыт первым. Если будет открыто больше, чем эти две книги, вы можете попробовать циклический подход, вот пример для использования:

Dim wkb as Workbook
Dim thisWb as Workbook
Dim expWb as Workbook
Set thisWb = ThisWorkbook
For Each wkb in Workbooks
    If wkb.Name Like "Export 2018-*" Then
        expWb = wkb
        Exit For
    End If
Next
If Not expWb Is Nothing Then
    'Found Export, do stuff like copy from expWb to thisWb
    expWb.Worksheets(1).Range("B20:B40").Copy
    thisWb.Sheets("PasteSheet").Range("A3").PasteSpecial xlValues
Else
    'Workbook with Export name not found
End If
Другие вопросы по тегам