Kopieren Sie Daten zwischen Arbeitsmappen mit dynamischen Zellen

Dec 21 2020

Versuch, Daten von einer Excel-Tabelle in eine andere zu kopieren (von New_data zum Bericht).

In der New_data-Tabelle finde ich das zweite Mal, dass System (daher starte ich die Suche unter dem ersten um N21) angezeigt wird. Dann muss ich alle Daten darunter aus den Spalten b - k kopieren, bis ich leere Zellen treffe. Wie erhalte ich die Anzahl der Zeilen, um nur gefüllte Zellen zu erfassen?

Range("B584:K641") muss dynamisch sein.


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

Antworten

3 FaneDuru Dec 21 2020 at 21:42

Versuchen Sie bitte den nächsten Code. Es sollte sehr schnell gehen (wenn ich richtig verstanden habe, wo nach "System" gesucht werden soll, beginnend mit was ...). Der Code setzt voraus, dass "new_data.csv" der Name der CSV-Arbeitsmappe ist. Wenn nicht, müssen Sie beim Definieren des shCSVBlattes den richtigen Namen verwenden :

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

Versuchen:

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

Beachten Sie, dass dieser Code systemnur in Spalte N nach Wörtern sucht . Wenn es sich um einen anderen Code handelt , müssen Sie die MATCH-Funktion anpassen

1 TestPilot10 Dec 21 2020 at 20:28

Ich setze einen Bereich, der dem gefilterten Bereich entspricht, und starte eine Schleife, um zu zählen, wie viele nicht leere Zellen bis zur ersten leeren Zelle in Spalte B auftreten.

    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

Ich habe eine Stapelüberlauf-Frage gefunden, die hilfreich war, um eine Antwort zu finden. Suchen Sie die Zelladresse