Kopiere celler til næste tomme celle

Prøv nedenstående. Bemærk at filnavne og fanenavne skal ændres:

Sub CopyData()
    Dim sMappe_fra, sArk_fra, sRange_fra, sMaxCol_fra As String
    Dim sMappe_til, sArk_til, sRange_til As String
    Dim lMaxRows_fra, lMaxRows_til As Long


    sMappe_fra = "Kopiere celler til næste tomme celle.xlsm" ' Navnet på den åbne Excel-fil, der skal kopieres FRA
    sMappe_til = "Kopiere celler til næste tomme celle.xlsm"  ' Navnet på den åbne Excel-fil, der skal kopieres TIL
     
    sArk_fra = "Indlæsning"    ' Navnet på den fane, der skal kopieres FRA
    sArk_til = "Data"          ' Navnet på den fane, der skal kopieres TIL
     
    lMaxRows_fra = Workbooks(sMappe_fra).Sheets(sArk_fra).Cells(Rows.Count, "A").End(xlUp).Row ' Antal rækker i FRA
    lMaxRows_til = Workbooks(sMappe_til).Sheets(sArk_til).Cells(Rows.Count, "A").End(xlUp).Row ' Antal rækker i TIL
     
    sMaxCol_fra = Workbooks(sMappe_fra).Sheets(sArk_fra).Cells(1, Columns.Count).End(xlToLeft).Address ' Mellemregning
    sMaxCol_fra = Mid(sMaxCol_fra, 2, InStr(2, sMaxCol_fra, "$") - 2)  ' Antal kolonner (antal i FRA bestemmer også antal i TIL
     
    If (lMaxRows_til = 1) Then ' sArk_til er tom. Overskrifter i række 1 skal kopieres med.
        sRange_fra = "A1:" & sMaxCol_fra & lMaxRows_fra
        sRange_til = sRange_fra
        Workbooks(sMappe_til).Sheets(sArk_til).Range(sRange_til) = Workbooks(sMappe_fra).Sheets(sArk_fra).Range(sRange_fra).Value ' Celleindhold kopieres
             
    Else    ' Der er data i sArk_til i forvejen. Overskrifter i række 1 skal IKKE kopieres med
        sRange_fra = "A2:" & sMaxCol_fra & lMaxRows_fra ' Arealet i FRA, der skal kopieres
        sRange_til = "A" & (lMaxRows_til + 1) & ":" & sMaxCol_fra & (lMaxRows_til + lMaxRows_fra - 1) ' Arealet i i TIL, der skal kopieres til.
        Workbooks(sMappe_til).Sheets(sArk_til).Range(sRange_til) = Workbooks(sMappe_fra).Sheets(sArk_fra).Range(sRange_fra).Value ' Celleindhold kopieres
         
        ' ###################### NOTE #################
        ' Nedenstående linje gør kolonne A til et fortløbende nummer (dvs. at indhold fra kolonne A ikke kopieres)
        ' Skal kolonne A kopieres uændret, skal nedenstående linje slettes
        Workbooks(sMappe_til).Sheets(sArk_til).Range("A" & lMaxRows_til).AutoFill Destination:=Workbooks(sMappe_til).Sheets(sArk_til).Range("A" & lMaxRows_til & ":A" & (lMaxRows_til + lMaxRows_fra - 1)), Type:=xlFillSeries
    End If
             
End Sub

Hej igen

Mit første løsningsforslag blev lidt for generel, og løste ikke opgaven. Det gør denne:

Sub CopyData2()
    Dim sRange_til As String
    Dim lRows_til As Long

    lRows_til = ActiveWorkbook.Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
    sRange_til = "A" & (lRows_til + 1) & ":F" & (lRows_til + 13)
    ActiveWorkbook.Sheets("Data").Range(sRange_til) = ActiveWorkbook.Sheets("Indlæsning").Range("A40:F52").Value
End Sub