Как я могу заставить этот код копировать и вставлять значения, которые соответствуют одному условию, которое вводится в ячейку в активной книге? - PullRequest
0 голосов
/ 08 октября 2019

Я хочу автоматизировать процесс ввода данных на ежемесячной основе, исходя из определенных условий. Поэтому в основном мне нужен командный лист, который будет извлекать все исходные данные из исходной рабочей книги, которые соответствуют месяцу, указанному пользователем в активной рабочей книге. Так, например, если вы поместите «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 в диапазоне исходных данных содержит месяц.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...