Я хочу автоматизировать процесс ввода данных на ежемесячной основе, исходя из определенных условий. Поэтому в основном мне нужен командный лист, который будет извлекать все исходные данные из исходной рабочей книги, которые соответствуют месяцу, указанному пользователем в активной рабочей книге. Так, например, если вы поместите «March» в раскрывающемся меню ячейки b2, то при нажатии для запуска макроса он копирует все строки данных с маршем в столбце month и вставляет их в целевую книгу.
Я уже написал некоторый код, но я думаю, что его можно улучшить. Я хочу, чтобы он вставлялся в цикл (я полагаю, это более эффективно). Я также хочу, чтобы код автофильтровался перед копированием и вставкой, а не копированием, в зависимости от условия, которое используется в данный момент (я думаю, что это также более эффективно). Наконец, прямо сейчас код копируется в пустую строку между строками. Мне бы хотелось, чтобы он просто вставлял строки с данными.
Sub CopyDatoToAnotherWorkbook()
Dim srcWB As Workbook, destWB As Workbook, macroWB As Workbook
Dim srcWS As Worksheet, destWS As Worksheet, macroWS As Worksheet
Dim FilePath As String
Dim lr As Long, lr2 As Long, r As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open "C:\Users\SOURCE FILE.xlsx"
Workbooks.Open "C:\Users\DESTINATION FILE.xlsx"
Set srcWB = Workbooks("SOURCE FILE.xlsx") 'Setting the source workbook
Set srcWS = srcWB.Sheets("SOURCE DATA SHEET") 'Setting the source worksheet
Set macroWB = Workbooks("Working File Creator.xlsm") 'Setting the source workbook
Set macroWS = macroWB.Sheets("Command Sheet")
'Finding the last row used in column A on source worksheet
lr = srcWS.Cells(Rows.Count, "A").End(xlUp).Row
Set destWB = Workbooks("DESTINATION FILE.xlsx")
'Setting the destination worksheet
Set destWS = destWB.Sheets("Monthly Data")
'Looping through rows on source worksheets
For r = lr To 2 Step -1
'Finding the first empty row in column A on destination worksheet
lr2 = destWS.Cells(Rows.Count, "A").End(xlUp).Row + 1
'Copying data that meets month provided in month dropdown of Macro command sheet cell B2
If srcWS.Range("L" & r).Value = macroWS.Range("B2") Then
srcWS.Rows(r).Copy Destination:=destWS.Range("A" & lr2 + 1)
End If
Next
'Closing the destination workbook
destWB.Close True
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = False
End Sub
Приведенный выше код работает сейчас, но я бы хотел, чтобы он работал быстрее / сглаживался и не вставлял дополнительные пустые строки. Мне также интересно, если бы использование автофильтра было бы лучшим способом сделать это. Он копирует столбцы данных с A по Q и тысячи строк, если они указаны для указанного месяца в листе команд. Диапазон L в диапазоне исходных данных содержит месяц.