Oprettet man. d. 07. januar 2013 kl. 13:07:16

Kibs
Kibs (4.790 point. Point ude: 30)


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?

Skrevet tir. d. 08. januar 2013 kl. 22:19:16| #1

H_Klein
H_Klein (10.870 point)
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

Skriv et indlæg




Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] [img]link til billede[/img]
Web- og emailadresser omdannes automatisk til links

Log ind

   



Seneste spørgsmål

bid kode der låser alt op i access

Oprettet den 1. juli 2015 kl. 10.54
andersschou giver 60 point for svar | Giv et svar »

bid kode der smider alle brugere af

Oprettet den 1. juli 2015 kl. 10.53
andersschou giver 60 point for svar | Giv et svar »

Excel, VBA, Rense tekst i én kolonne

Oprettet den 27. juni 2015 kl. 07.42
JonFossa giver 30 point for svar | Giv et svar »






Computerworld

Teaser billede

Løsladt top-chef i 3A-it: Det var ikke bestikkelse - sådan hang ordningen sammen

Tidligere koncern-chef i Atea, Peter Trans, bryder navneforbuddet og står frem som en af de tre topchefer, der netop er blevet løsladt efter 14 dage i varetægtsfængsel mistænk for korruption.

CIO

Teaser billede

Skal du hoppe med på Microsofts store opgraderings-tog?

ComputerViews: Det er slut med de kæmpestore system-fornyelser med års mellemrum fra Microsofts side. Istedet forsøger selskabet at sætte gang i løbende og vedvarende opgraderinger. Du kan...

Comon

Teaser billede

Prøvekørt: Her er Microsofts splinternye Surface-computer - til noget lavere pris end Surface Pro 3

Prøvekørt: Microsoft er klar med en helt ny Surface-computer, der bliver billigere end den nuværende Surface 3 Pro, selv om de er ret ens. Vi har prøvekørt den nye maskine. Se vores dom her.

Channelworld

Teaser billede

BREAKING: Danske it-folk idømt lange fængselsstraffe for momssvindel i million-klassen

Tre tiltalte skal flere år i fængsel for svindel med moms i den tidligere it-forhandler Multimedia World.

White paper

Teaser billede

Sådan sørger du for at it-sikkerhedspolitikken er effektiv og konstant opdateret

Antallet af trusler mod virksomhedens dataintegritet mangedobles i takt med, at vi tager flere og flere enhedstyper og cloudservices i brug.



Udgiver · © 2015 Computerworld A/S · Hørkær 18 · 2730 Herlev · Tlf.: 77 300 300 · Fax: 77 300 301 · Brug af personoplysninger