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