Hej!
Jag kör ett macro i Exel 2013 plus som kopierar in en text från ett blad mellan kolumn A till T i första raden på ett annart ark.
Efter 20 kolumner, Från A till T så skulle jag vilja att det byter till ny rad och börja skriva på rad 5 i stället.
och efter det på rad 10 osv,
Min kod jag använder nu ser ut som nedan, Men hur skulle den kunna se ut efter ombyggnad till min tanke här ovan?.

intal = ActiveCell.Row

Rows(intal).Select
    Selection.Copy
    Sheets("data").Select
    Range("A1").Select
    ActiveSheet.Paste
    antal = Range("d1").Value '20
    For i = 1 To antal
    Sheets("Data").Select
    Range("A6:C6").Select
    Selection.Copy
    Sheets("namn").Select

    Range(Cells(1, i), Cells(1, i)).Select ' väljer rad 1 i varje kolumn
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

Vet inte riktigt hur du menar?
Antar att du inte skall hålla på att kopiera från A6:C6 hela tiden

Men koden nedan gör just detta 100 gånger.
Den byter rad efter 20

Sen behöver man inte hålla på och kopiera och selecta
I och med att excel är uppbyggt på objekt så
räcker det med att ange objekten och sen skriva från och till direkt

Sub ny()
Dim intal As Integer
Dim antal As Integer
Dim i As Integer
Dim j As Integer
Dim rad As Integer

intal = ActiveCell.Row
 
Rows(intal).Select
    Selection.Copy
    Sheets("data").Select
    Range("A1").Select
    ActiveSheet.Paste
    'antal = Range("d1").Value '20
    antal = 20
    
    For j = 1 To 100
       Sheets("Data").Select
       Range("A6:C6").Select
       Selection.Copy
       Sheets("namn").Select
        If j = 1 Then
            rad = 1
        Else
            rad = j * 5 - 5
        End If

        For i = 1 To antal

'                Range(Cells(1, i), Cells(1, i)).Select ' väljer rad 1 i varje kolumn
                Range(Cells(rad, i), Cells(rad, i)).Select ' väljer rad 1 i varje kolumn
                
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=True
        Next i

    Next j


End Sub

Två alt att använda objekten och skriva direkt

Sub objekt_ny()
Dim intal As Integer
Dim antal As Integer
Dim i As Integer
Dim j As Integer
Dim rad As Integer
Dim k As Integer

Dim DATA As Object
Dim NAMN As Object


Set DATA = Sheets("data")
Set NAMN = Sheets("namn")

intal = ActiveCell.Row
 
Rows(intal).Select
    Selection.Copy
    With DATA
        .Activate
        .Range("A1").Select
        .Paste
    End With

    'antal = Range("d1").Value '20
    antal = 20
    
    NAMN.Activate
    For j = 1 To 100

        If j = 1 Then rad = 1 Else rad = j * 5 - 5

        For i = 1 To antal
                        
                '<<<< alt 1 >>>
                For k = 1 To 3
                    NAMN.Cells(rad + k - 1, i).Value = DATA.Cells(6, k).Value
                Next k
                
                '<<<< alt 2 >>>
'                NAMN.Cells(rad, i).Value = DATA.Cells(6, 1).Value
'                NAMN.Cells(rad + 1, i).Value = DATA.Cells(6, 2).Value
'                NAMN.Cells(rad + 2, i).Value = DATA.Cells(6, 3).Value
        
        Next i
    Next j

End Sub

Tackar så mycket för detta. Funkar som jag tänkt.
Mvh/ Jocke