Kopiuj dane między skoroszytami z dynamicznymi komórkami
Próba skopiowania danych z jednego arkusza kalkulacyjnego Excel do innego (z New_data do raportu).
W arkuszu kalkulacyjnym New_data po raz drugi N21
pojawia się System (stąd dlaczego rozpoczynam wyszukiwanie poniżej pierwszego o ), a następnie muszę skopiować wszystkie dane poniżej z kolumn b - k, aż trafię do pustych komórek. Jak uzyskać liczbę wierszy, aby przechwytywać tylko wypełnione komórki?
Range("B584:K641")
musi być dynamiczny.
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
Odpowiedzi
Spróbuj następnego kodu. Powinien być bardzo szybki (jeśli dobrze zrozumiałem, gdzie szukać „systemu”, zaczynając od czego…). Kod zakłada, że „new_data.csv” to nazwa skoroszytu csv. Jeśli nie, podczas definiowania shCSV
arkusza musisz użyć jego prawdziwej nazwy :
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
Próbować:
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
Zauważ, że ten kod wyszukuje słowo system
tylko w kolumnie N. Jeśli jest gdzieś indziej, musisz dostosować funkcję MATCH
Ustawiam zakres tak, aby był równy przefiltrowanemu zakresowi i rozpoczynam pętlę, aby policzyć, ile pustych komórek nie występuje do pierwszej pustej komórki w kolumnie 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
Znalazłem pytanie dotyczące przepełnienia stosu, które pomogło w znalezieniu odpowiedzi. Znajdź adres komórki