Копирование данных между рабочими книгами с динамическими ячейками
Попытка скопировать данные из одной таблицы Excel в другую (из New_data в отчет).
В электронной таблице New_data я обнаружил, что второй раз появляется System (поэтому я начинаю поиск ниже первого в N21
), тогда мне нужно скопировать все данные под ней из столбцов b - k, пока я не нажму пустые ячейки. Как получить количество строк для захвата только заполненных ячеек?
Range("B584:K641")
должен быть динамичным.
Sub CopyWorkbook()
Range("N21").Select
Cells.Find(What:="system", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range("B584:K641").Select
Selection.Copy
Application.WindowState = xlNormal
Windows("report.xlsx").Activate
Range("A2").Select
ActiveSheet.Paste
Windows("new_data.csv"). _
Activate
End Sub
Ответы
Пожалуйста, попробуйте следующий код. Это должно быть очень быстро (если я правильно понял, где искать «система», начиная с чего ...). Код предполагает, что "new_data.csv" - это имя книги csv. Если нет, вы должны использовать его настоящее имя при определении shCSV
листа:
Sub CopyWorkbook()
Dim shR As Worksheet, shCSV As Worksheet, lastRow As Long, systCell As Range, arr
Set shR = Workbooks("report.xlsx").ActiveSheet 'use here the sheet you need to paste
'it should be better to use the sheet name.
'No need to have the respective sheet activated at the beginning
Set shCSV = Workbooks("new_data.csv").Sheets(1) 'csv file has a single sheet, anyhow
lastRow = shCSV.Range("B" & rows.count).End(xlUp).row
Set systCell = shCSV.Range("B21:B" & lastRow).Find(What:="system", _
After:=shCSV.Range("B21"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If systCell Is Nothing Then MsgBox "No 'sytem' cell has been found...": Exit Sub
arr = shCSV.Range(systCell, shCSV.Range("K" & lastRow)).Value
shR.Range("A2").Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub
Пытаться:
Sub test()
Dim LR As Long
Dim Ini As Long
LR = Range("B" & Rows.Count).End(xlUp).Row 'last non empty row in column B
Ini = Application.WorksheetFunction.Match("system", Range("N21:N" & LR), 0) + 20 'position of system after n21
Range("B" & Ini & ":K" & LR).Copy
'''rest of your code to paste
End Sub
Обратите внимание, что этот код ищет слово system
только в столбце N. Если это где-то еще, вам необходимо адаптировать функцию ПОИСКПОЗ.
Я устанавливаю диапазон, равный отфильтрованному диапазону, и запускаю цикл для подсчета количества пустых ячеек до первой пустой ячейки в столбце B.
Sub CopyWorkbook()
ThisWorkbook.Sheets("new_data").Activate
Range("N21").Select
Dim rng As Range
Set rng = Cells.Find(What:="system", After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
Dim i As Double
i = rng.Row
Do Until ThisWorkbook.Sheets("new_data").Range("B" & i) = vbNullString
i = i + 1
Loop
i = i - 1
Range("B" & rng.Row & ":K" & i).Select
Selection.Copy
Application.WindowState = xlNormal
Windows("report.xlsx").Activate
Range("A2").Select
ActiveSheet.Paste
Windows("new_data.csv").Activate
End Sub
Я нашел вопрос о переполнении стека, который помог найти ответ. Найти адрес ячейки