Kopiuj dane między skoroszytami z dynamicznymi komórkami

Dec 21 2020

Próba skopiowania danych z jednego arkusza kalkulacyjnego Excel do innego (z New_data do raportu).

W arkuszu kalkulacyjnym New_data po raz drugi N21pojawia 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

3 FaneDuru Dec 21 2020 at 21:42

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 shCSVarkusza 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
1 FoxfireAndBurnsAndBurns Dec 21 2020 at 20:34

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 systemtylko w kolumnie N. Jeśli jest gdzieś indziej, musisz dostosować funkcję MATCH

1 TestPilot10 Dec 21 2020 at 20:28

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