Search code examples
excelvbamacosms-office

Store and Paste values with a dynamic array


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 key number in this case is "5"

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")

enter image description here

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


Solution

  • 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