Jeg har vedhæftet et regneark, som burde løse dit problem på elegant vis.
For andre interesserede har jeg pastet koden her:
Private Sub btnKopier_Click()
Dim wsOprindelig As Worksheet
Dim wsDestination As Worksheet
Dim rOprindelig As Range
Dim rDestination As Range
Dim iNumber As Integer
Dim i As Integer
Set wsOprindelig = ThisWorkbook.Sheets("Oprindelig")
Set wsDestination = ThisWorkbook.Sheets("Destination")
'// Ryd indholdet på destinationssiden
wsDestination.Cells.Clear
'// Sæt "arealet" af det, der skal flyttes.
'// På denne måde bliver det automatisk indstillet
With wsOprindelig
Set rOprindelig = .Range(.Range("A1"), _
.Cells(.Range("A1").End(xlDown).Row, .Range("A1").End(xlToRight).Column))
' Alternativ: Set rOprindelig = wsOprindelig.Range("A1:F18")
' (Hvis du er sikker på, at arealet kun er 6 x 18)
'// Antal gange feltet skal kopieres (hentes fra celle A1)
On Error Resume Next
iNumber = CInt(.Range("A1"))
If Err.Number > 0 Then iNumber = 1
On Error GoTo 0
End With
'// Destination:
With wsDestination
Set rDestination = .Range(.Range("A1"), .Cells(rOprindelig.Rows.Count, rOprindelig.Columns.Count))
'// Her bruger vi en løkke til at kopiere arealet det antal gange, vi ønsker.
For i = 1 To iNumber
'// Overfør data til den anden fane
rDestination.Value = rOprindelig.Value
'// Sæt det næste punkt
Set rDestination = .Range(.Cells(.Rows.Count, 1).End(xlUp).Offset(1), _
.Cells(rOprindelig.Rows.Count + rDestination.Rows.Count * i, _
rOprindelig.Columns.Count))
Next i
End With
'// Frigør hukommelse
Set rDestination = Nothing
Set rOprindelig = Nothing
Set wsOprindelig = Nothing
Set wsDestination = Nothing
End Sub
Forum start
Forummets regler
Sådan uploader du filer
Marker Accepteret løsning
Del dine regneark
Excel-regneark.dk
Automatisk generering af felter (blok)
Emne funktioner
