Copie dados entre livros de trabalho com células dinâmicas

Dec 21 2020

Tentando copiar dados de uma planilha Excel para outra (de New_data para relatório).

Na planilha New_data, acho que a segunda vez que System (por isso inicio a pesquisa abaixo do primeiro em N21) aparece, então preciso copiar todos os dados abaixo dele das colunas b - k até chegar às células em branco. Como obtenho a quantidade de linhas para capturar apenas células preenchidas?

Range("B584:K641") precisa 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

Respostas

3 FaneDuru Dec 21 2020 at 21:42

Tente o próximo código, por favor. Deve ser muito rápido (se eu entendi bem onde procurar 'sistema', começando com o quê ...). O código assume que "new_data.csv" é o nome da pasta de trabalho csv. Caso contrário, você deve usar seu nome real ao definir a shCSVplanilha:

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

Tentar:

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

Observe que este código está pesquisando palavra systemapenas na coluna N. Se estiver em outro lugar, você precisará adaptar a função MATCH

1 TestPilot10 Dec 21 2020 at 20:28

Eu defino um intervalo para igualar o intervalo filtrado e inicio um loop para contar quantas células não vazias ocorrem até a primeira célula vazia na coluna 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

Eu encontrei uma pergunta do Stack Overflow que foi útil para encontrar uma resposta. Encontre o endereço do celular