Kibs Nybegynder
07. januar 2013 - 13:07 Der er 1 kommentar

Kopier fra række indtil blank række

Hej

Jeg skal have lavet et loop af en slags. Som I kan se herunder skal jeg kopiere H2:J2, og sætte det ind i et andet ark i B2 (skal også transponeres). Derefter skal der køres en makro, og når den er kørt skal H3:J3 kopieres, makroen køres, og så fremdeles. Den skal så selv stoppe når der ikke længere er data i H.

    Sheets("Input").Select
    Range("H2:J2").Select
    Selection.Copy
    Sheets("Forside").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

Er der nogle der kan omdanne ovenstående til det jeg ønsker?
H_Klein Praktikant
08. januar 2013 - 22:19 #1
Hej Kibs,

Herunder to forslag til løsning.

Metode1 benytter den metode du efterlyser og kopierer én række af gangen.

Metode2 som er en del hurtigere, specielt hvis det drejer sig om mange data, kopierer ganske enkelt alle data fra "Input" - arket, (række 2 og nedefter) og sætter dem ind i arket "Forside".

Begge metoder tager højde for at der kan være data lagt ind i Forside-arket, og vil finde første ledige celle nedefter hvis pågældende celle er optaget.

---------------------------------
Sub metode1()

    Dim rk As Long
   
    Sheets("Input").Select
    rk = 2
    Do
    Cells(rk, 8).Select
    Range(Cells(rk, 8), Cells(rk, 10)).Select
    Selection.Copy
    Sheets("Forside").Select
    Cells(1, 2).Select
    If Cells(2, 2) = "" Then
    Cells(2, 2).Select
    ActiveSheet.Paste
    Else
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    End If
    Sheets("Input").Select
    rk = rk + 1
    Loop Until Cells(rk, 8) = ""
    Application.CutCopyMode = False
End Sub
--------------------------------------------------

--------------------------------------------------
Sub metode2()

    Sheets("Input").Select
    Cells(2, 8).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Forside").Select
    Cells(1, 2).Select
    If Cells(2, 2) = "" Then
    Cells(2, 2).Select
    ActiveSheet.Paste
    Else
    Cells(1, 2).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    End If
    Application.CutCopyMode = False
End Sub
----------------------------------------

Håber at det kan bruges og ellers må du lige vende tilbage.

Med venlig hilsen

Henrik
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

Opret Preview

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





Computerworld
Ny bil i 2030? Mercedes-Benz har allerede bygget den ... og den kører på 10 MacBooks
Mercedes-Benz F015 ligner ikke noget, du kan finde på hylderne hos nogen bilforhandler. Den stålgrå maskine med de indbydende former er da også mere en vision og et rullende eksperiment end en bil, du kan bruge til noget. Og så er den fyldt med MacBooks under motorhjelmen.
CIO
Morten Mogensens firma blev forsøgt svindlet, men snød selv svindleren: "Vi tager det som en oplevelse"
Dansk virksomhed blev bedt om af sende 100.000 kroner til en hemmelig konto via en mail, der var afsendt som en besked fra direktøren til regnskabsafdelingen. Phishing-forsøget blev opdaget, og direktøren og regnskabschefen tog en fiffig hævn.
Comon
Microsoft er klar med firmaets næste konsol: Her er lanceringsdatoen i Danmark
Det nye familiemedlem ankommer i butikkerne den 2. august. Se hvad der bydes på af nyheder til spil-og film-folket.
Channelworld
Nordmænd køber dansk software-hus - medarbejderne bliver
Norske Amesto Solutions har købt det det danske CRM-firma Adwiza, der har haft svært ved at opnå tilstrækkelig lønsomhed. Men det skal der laves om på nu, lyder det fra Norge.
White paper
Tjekliste: 10 tegn på, at du har behov for at modernisere din Backup og Recovery løsning
Gennemgå denne tjekliste for at afgøre, om dit miljø har behov for en mere moderne tilgang til backup og recovery. Hvis ikke du kan tjekke nogen af disse af, kan det være tid til at revurdere din databeskyttelse strategi.