Avatar billede bobjoern Nybegynder
11. marts 2013 - 15:34 Der er 1 kommentar og
1 løsning

Kopiere celler til næste tomme celle

Hej

Jeg mangler en makro, som skal samle en masse data for mig i et ark.

Der bliver noget manuelt, men jeg har brug for en funktion så jeg automatisk kan overføre data fra mit "indlæsning" ark til mit "data" ark.

Området A40 til F52 skal kopieres fra arket "indlæsning" som værdier til arket "data", startende i celle A2-F2.

Næste gang jeg vil indsætte "indlæsning" A40 til F52 i "data", skal den så indsætte efter næste tomme celle i række A, således at data kommer til at stå i en lang række efter hinanden, så jeg kan viderebehandle det i pivot/BI program.

Er der nogle der har en hurtig stump kode til det?
Avatar billede Niels_Bjarne Praktikant
24. marts 2013 - 11:25 #1
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
Avatar billede Niels_Bjarne Praktikant
24. marts 2013 - 12:02 #2
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
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester