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

Kibs
Kibs (5.080 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 (11.260 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

Kopier tekst, indtil nyt tal

Oprettet den 27. august 2015 kl. 09.05
Butterlfy giver 60 point for svar | Giv et svar »

Slette række, hvis tekst starter med N

Oprettet den 24. august 2015 kl. 10.58
Butterlfy giver 30 point for svar | Giv et svar »

VBA opdatere regneark fra Master - flere brugere.

Oprettet den 23. august 2015 kl. 20.38
RasmusJul giver 30 point for svar | Giv et svar »

Seneste guides

Fjern reklamer i Edge - Windows 10
Download/import af tabeller - IE
Manual til casio ur





Computerworld

Teaser billede

YouSee tvunget til at splitte bredbånd og tv op: Nu kan du droppe tv-pakken

YouSee vil fremover levere bredbånd uden at kræve, at kunderne samtidig køber en tv-pakke. Det er dog mest af alt et tiltag, der kommer, fordi TDC er tvunget til det.

CIO

Teaser billede

Tre ting du skal lære af sikkerhedsproblemerne hos Tesla, Chrysler og Volkswagen

Tesla, Chrysler og Volkswagen er alle ramt af sårbarheder, men selskaberne reagerer vidt forskelligt. Vi har samlet tre regler, som de burde have fulgt - og som kan hjælpe din virksomhed med at...

Comon

Teaser billede

Stortest af 17 grafikkort: Spilgrafik til ethvert budget

Hvordan vælger man det rigtige grafikkort til den rigtige pris? Denne stortest kan give dig svaret.

Channelworld

Teaser billede

HP splittes op i to danske selskaber: Her er de to nye topchefer i Danmark

HP har sat navne på, hvem der fra 1. november kommer til at stå i spidsen for de to nye danske HP-selskaber, som opstår, når hardwarekoncernen splittes i to.

White paper

Teaser billede

Intelligente forretningsprocesser

Læs her om de centrale egenskaber ved intelligente forretningsprocesser, deres fordele og hvordan du hæver dine egne forretningsprocessers IQ.



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