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

Kibs
Kibs (3.340 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.360 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

Print variabelt antal

Oprettet den 16. september 2014 kl. 11.38
Butterlfy giver 60 point for svar | Giv et svar »

Excel makro i Word skabelon - ikke tilgængelig i nyt...

Oprettet den 10. september 2014 kl. 21.20
jO_Mors giver 50 point for svar | Giv et svar »

VBA fejler

Oprettet den 9. september 2014 kl. 12.37
blazer giver 60 point for svar | Giv et svar »






Computerworld

Teaser billede

TDC smider pris-bombe: Ubegrænset mobiltelefoni i 31 lande

For et fast månedligt beløb kan TDC's erhvervskunder tale frit i mobil i 31 forskellige lande.

CIO

Teaser billede

Store it-projekter: Sådan styrer du dem sikkert i mål

Hvilken projektform skal du vælge, og hvad er den bedste måde at lede it-projekter på? Her er ulemper og fordele ved de forskellige projektledelsesformer.

Comon

Teaser billede

TDC klar med iPhone 6 om to uger - men er tavs om antallet

Om få uger får danskerne adgang til de nye iPhones. Men der er uvished om, hvor mange telefoner der kommer til Danmark.

Channelworld

Teaser billede

Kommune droppede iPads: De var for billige - og for besværlige

En klar pædagogisk strategi og hensynet til det eksisterende it-setup fik lærere og politikere i Nordfyn Kommune til at dumpe iPads, da der skulle købes tablet-computere til eleverne - også selv om...

White paper

Teaser billede

Den lette vej fra legacy til SOA

Få med dette webcast fra BluePhoenix et teknisk overblik over, hvad en legacy-modernisering kan indebære, og hvad der bedst kan betale sig.



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