Copier des données entre des classeurs avec des cellules dynamiques

Dec 21 2020

Essayer de copier des données d'une feuille de calcul Excel à une autre (de New_data au rapport).

Dans la feuille de calcul New_data, je trouve que la deuxième fois que System (d'où la raison pour laquelle je lance la recherche en dessous du premier à N21) apparaît, alors je dois copier toutes les données en dessous des colonnes b - k jusqu'à ce que je frappe des cellules vides. Comment obtenir le nombre de lignes pour capturer uniquement les cellules remplies?

Range("B584:K641") doit être dynamique.


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

Réponses

3 FaneDuru Dec 21 2020 at 21:42

Essayez le code suivant s'il vous plaît. Cela devrait être très rapide (si j'ai bien compris où chercher «système», en commençant par quoi ...). Le code suppose que "new_data.csv" est le nom du classeur csv. Sinon, vous devez utiliser son vrai nom lors de la définition de la shCSVfeuille:

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

Essayer:

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

Notez que ce code recherche le mot systemuniquement dans la colonne N. S'il se trouve ailleurs, vous devrez adapter la fonction MATCH

1 TestPilot10 Dec 21 2020 at 20:28

J'ai défini une plage pour qu'elle soit égale à la plage filtrée et je lance une boucle pour compter le nombre de cellules non vides jusqu'à la première cellule vide de la colonne 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

J'ai trouvé une question Stack Overflow qui m'a aidé à trouver une réponse. Trouver l'adresse de la cellule