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

Kibs
Kibs (945 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 (7.070 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

konvertering af MS SQL datoformat

Oprettet den 20. maj 2013 kl. 11.54
Tago giver 60 point for svar | Giv et svar »

Lille VBA makro

Oprettet den 16. maj 2013 kl. 16.15
m_haahr giver 30 point for svar | Giv et svar »

Scroll til top i textbox

Oprettet den 16. maj 2013 kl. 12.34
martin_moth giver 30 point for svar | Giv et svar »








Tips & Tricks fra PC World

Teaser billede

Her gemmer de hemmelige kopier af dine data sig

Hvad sker der, hvis din Mac bryder sammen og du ikke har taget backup? Fortvivl ikke. Der er gode chancer for, at der rundt omkring alligevel ligger sikkerhedskopier af dine data.


Anmeldelser fra PC World

Teaser billede

Test: Samsung Galaxy S4 er et hit - trods gøglertricks

Kan Samsung beholde førertrøjen i det store Android-race? Galaxy S4 er smækfyldt med innovative funktioner, men også med en del gøgl. Er det for meget? Få vores dom over Samsungs nye topmodel.


Seneste blogindlæg

Teaser billede

Tvangslukke spørgsmål: Hvad er den bedste løsning?

Hej Vi har mange åbne spørgsmål på Eksperten. Vi ville gerne tvangslukke dem - så et spørgsmål efter f.eks. 6 måneder lukkes. Men der er et par uklarheder som ville være gode at få lidt input til:...


Nyheder fra PC World

Teaser billede

Ny opfindelse: Oplad din mobil på 20 sekunder

Måske er det snart slut med at lade mobilen op hver aften. Med ny opfindelse kan telefonen få fuld energi på sølle 20 sekunder.


Nyheder fra Computerworld

Teaser billede

Snart kan du printe din egen pizza

Inden længe kan det blive muligt at printe pizzaer og andre fødevarer.


IT Kurser
Samarbejdspartnere

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