Copiar datos entre libros de trabajo con celdas dinámicas

Dec 21 2020

Intentando copiar datos de una hoja de cálculo de Excel a otra (de New_data al informe).

En la hoja de cálculo New_data, encuentro la segunda vez que System (de ahí el motivo por el que comienzo la búsqueda debajo de la primera en N21) aparece, luego necesito copiar todos los datos debajo de las columnas b - k hasta que llegue a las celdas en blanco. ¿Cómo obtengo la cantidad de filas para capturar solo celdas llenas?

Range("B584:K641") necesita ser dinámico.


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

Respuestas

3 FaneDuru Dec 21 2020 at 21:42

Pruebe el siguiente código, por favor. Debería ser muy rápido (si entendí correctamente dónde buscar 'sistema', comenzando con qué ...). El código asume que "new_data.csv" es el nombre del libro de trabajo csv. De lo contrario, debe usar su nombre real al definir la shCSVhoja:

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

Intentar:

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

Tenga en cuenta que este código systemsolo busca palabras en la columna N. Si está en otro lugar, deberá adaptar la función COINCIDIR

1 TestPilot10 Dec 21 2020 at 20:28

Establezco un rango para igualar el rango filtrado y comienzo un ciclo para contar cuántas celdas no vacías ocurren hasta la primera celda vacía en la columna 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

Encontré una pregunta de Stack Overflow que fue útil para encontrar una respuesta. Encontrar la dirección de la celda