Store and Paste values with a dynamic array-CodePudding

first of all sorry for my bad english, it's not my native lang. i have a dynamic table that changes its content when i insert a specific keynumber

The keynumber in this case is "5" and all the content of that sheet changes according to the number i enter (from 1 to 42).

What i want to do is copy all the data and paste only the values in an empty row on the same sheet. i achieved that with the next code:

Sheets("Biblia General").Range("B8:H142").Copy
Sheets("Biblia General").Range("M8").PasteSpecial xlPasteValues
'Remove the animation around the copied cell
Application.CutCopyMode = False
Selection.Sort key1:=Range("N8")

when i press the button copiar it copies and then paste on the right of the sheet.

But now i need to do the same thing but for the whole keynumbers, for example i need to run a copy and paste of the values of all the tables for 1 to 42 not just one by one.

i don't know how to enter for example the keynumber 1 calculate the sheet then copy the content and paste the values to the right, then do it again but for keynumber 2 and so on until it ends at keynumber 42...

is there a way i can achieve that? im not realy familiar with vba but i think i need to do a dynamic array or something like that

thanks in advance

CodePudding user response：

I think it is easier without an array:

  Dim i As Long
  
  For i = 1 To 42
    [D1].Value = i    'set the key number (please check the address
    Sheets("Biblia General").Range("B8:H142").Copy '135 rows
    'Paste each block below the previous one
    Sheets("Biblia General").Range("M8").Offset((i - 1) * 135, 0).PasteSpecial xlPasteValues
    'Remove the animation around the copied cell
    Application.CutCopyMode = False
    Selection.Sort key1:=Range("N8")
  Next i

CodePudding user response：

Copy Values by Assignment

When you do drg.Value = srg.Value, it is as fast as you can copy values (not formulas or formats). It is called Copying by Assignment and there is one simple rule: both ranges have to be of the same size (same number of rows and columns). Usually, you only know the first cell of the destination range and you know it has to be of the size of the source range. Let's call the first cell dfCell. To create a reference to the destination range you will do the following:
```
Dim drg As Range: Set drg = dfCell.Resize(srg.Rows.Count, srg.Columns.Count)
```

The Code

Option Explicit

Sub CopyData()
    
    Const wsName As String = "Biblia General"
    Const ClaveCount As Long = 42
    Const ClaveAddress As String = "C1" ' Clave
    Const LoteAddress As String = "C3" ' Lote
    Const srgAddress As String = "B8:H142"
    Const dfCellAddress As String = "M8"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim srg As Range: Set srg = ws.Range(srgAddress)
    Dim Clave As Range: Set Clave = ws.Range(ClaveAddress)
    Dim Lote As Range: Set Lote = ws.Range(LoteAddress)
    
    Dim rCount As Long: rCount = srg.Rows.Count
    Dim cCount As Long: cCount = srg.Columns.Count
    
    Dim dfCell As Range: Set dfCell = ws.Range(dfCellAddress)
    
    Application.ScreenUpdating = False
    
    dfCell.Offset(, -1).Resize(ws.Rows.Count - dfCell.Row   1, cCount   1) _
        .ClearContents
    
    Dim drg As Range
    Dim dclrrg As Range
    Dim n As Long
    
    For n = 1 To ClaveCount
        Clave.Value = n
        Set drg = dfCell.Resize(rCount, cCount)
        drg.Value = srg.Value
        If n = 1 Then
            drg.Cells(1).Offset(, -1).Value = "Lote" ' Lote
            ' exclude headers
            rCount = rCount - 1
            Set srg = srg.Resize(rCount).Offset(1)
            Set drg = drg.Resize(rCount).Offset(1)
        End If
        drg.Columns(1).Offset(, -1).Value = Lote.Value ' Lote
        drg.Sort drg.Columns(2), xlAscending, , , , , , xlNo
        Set dfCell = drg.Columns(2) _
            .Find("*", , xlValues, , , xlPrevious).Offset(1, -1)
        Set dclrrg = drg.Resize(drg.Row   rCount - dfCell.Row) _
            .Offset(dfCell.Row - drg.Row, -1).Resize(, cCount   1)
        dclrrg.ClearContents
    Next n

    Application.ScreenUpdating = True
    
    MsgBox "Data copied.", vbInformation, "CopyData"

End Sub