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

Kibs
Kibs (3.210 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 (9.230 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

Indsæt kopieret tekst i userform

Oprettet den 20. august 2014 kl. 14.03
Butterlfy giver 30 point for svar | Giv et svar »

VBA Word Validering af teksbox til registreringsnr på bil

Oprettet den 18. august 2014 kl. 15.09
Siwi123 giver 30 point for svar | Giv et svar »

Random pop-up

Oprettet den 15. august 2014 kl. 13.48
Rubensoren giver 200 point for svar | Giv et svar »

Seneste guides

Opret BOOTBAR USB pen ...
Undgå reklamerne på iPad





Computerworld

Teaser billede

Guide: Sådan laver du din egen private "Dropbox"-server med Raspberry Pi på et kvarter

Selv uden de store Linux-evner kan en nybegynder relativt nemt lave en Sync-server, som fungerer på samme måde som de kendte sky-tjenester, så længe man er væbnet med tålmodighed og gåpåmod.

CIO

Teaser billede

Her er læren af Windows 8.1: Sådan kan du undgå kaos næste gang

ComputerViews: Opgraderingen Windows 8.1 har givet store problemer for mange brugere. Problemet skal findes i en grundlæggende mangel, som du også selv bærer et ansvar for.

Comon

Teaser billede

Stor guide: Her er den nødvendige software til din studie-pc

Software til din studiecomputer kan koste dig over 10.000 kroner gennem uddannelsen, men du kan også klare dig ganske gratis. Her er en guide til den nødvendige software på både Mac og pc - og til...

Channelworld

Teaser billede

Analyse: Derfor kan 2014 blive det bedste Mac-år nogensinde

Analyse: Mens salget af pc'er falder støt, ser 2014 ud til at blive et rekord-år for Mac-computere. Vi har kigget på salgstallene og fremskriver friskt salget. Se her, hvad vi når frem...

White paper

Teaser billede

Mobility og autentificering

Aladdin eToken er et stærkt token lifecycle management-system, som understøtter to-faktor-autentificering og fungerer med VPN og kryptering.



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