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

Kibs
Kibs (3.810 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.890 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

Kør macro når filen åbnes

Oprettet den 11. december 2014 kl. 12.07
Andreeas giver 30 point for svar | Giv et svar »

Udregning direkte i formularen

Oprettet den 9. december 2014 kl. 11.42
Soegaard78 giver 200 point for svar | Giv et svar »

Fjerne dialogboks ved lukning af et Excelark med...

Oprettet den 8. december 2014 kl. 09.43
Buggelsgaard giver 60 point for svar | Giv et svar »

Seneste guides

Malwarebytes version 2.0.3.1025
Find ejeren af et vilkårligt domæne
Opret BOOTBAR USB pen ...





Computerworld

Teaser billede

På vejen hjem fra lufthavnen opdager jeg at min telefon via Bluetooth prøver at forbinde med min bil - og Bluetooth har aldrig været aktiveret på den telefon

På vejen hjem fra lufthavnen opdager jeg at min telefon via Bluetooth prøver at forbinde med min bil - og Bluetooth har aldrig været aktiveret på den telefon

CIO

Teaser billede

Skat sparer 100 millioner kroner med ny it-indkøbs-politik: Så enkelt kan det gøres

Med en spritny udbudsfabrik har Skat præsteret at spare 100 millioner kroner på it-driftsudbud. Læs her, hvordan Skat har strømlinet sine udbudsproces.

Comon

Teaser billede

Stortest: Her er de bedste gratis antivirus-programmer

Kan gratis sikkerhedssoftware virkelig beskytte din pc? Svaret er ja, hvis du vælger det rette produkt. Læs her en test af de mest pålidelige gratis sikkerhedsprogrammer.

Channelworld

Teaser billede

Faneflugt blandt Microsofts danske partnere: Fylder hylderne med Microsoft-rivalers produkter

Massevis af danske forhandlere af Microsofts klassiske økonomisystem C5 er begyndt at fylde hylderne med produkter fra Microsofts rivaler. "Det virker som om, at Microsoft mere eller mindre...

White paper

Teaser billede

ITIL og best practices i dagligdagen

Dette Computerworld Tema beskriver, hvad ITIL er, og hvordan det i praksis betaler det sig at ændre alt det, man gør forkert i dagligdagen.



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