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