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

Kibs
Kibs (6.315 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 (12.495 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

Slette tekst i række

Oprettet den 3. maj 2016 kl. 21.59
castleman giver 30 point for svar | Giv et svar »

Automatisk opdatering af pivottabel undtaget 0

Oprettet den 2. maj 2016 kl. 12.10
Butterlfy giver 60 point for svar | Giv et svar »

Excel annulerer kopiering efter gem og luk

Oprettet den 2. maj 2016 kl. 11.26
depet giver 100 point for svar | Giv et svar »






Computerworld

Teaser billede

Flere danske banker i knæ: Ramt af alvorlige netbank-problemer

Opdateret: SDC er ramt er omfattende problemer, der i øjeblikket sender en stribe danske netbanker til tælling.

CIO

Teaser billede

Årets CIO 2016: Her er Danmarks fem bedste it-chefer

Årets CIO 2016: Den eftertragtede titel som Årets CIO i Danmark skal snart uddeles for 11. gang af Computerworld, IDC og Dansk IT. Her er de fem nominerede til Årets CIO 2016.

Comon

Teaser billede

Se billederne: Her er et gratis open source-alternativ til Microsofts Office 365

Open 365 skal være den åbne kildekodes gratis alternativ til Microsofts eller Googles kontorløsninger til deling og redigering af dokumenter online samt synkronisering af filer i skyen. Se her,...

Channelworld

Teaser billede

KMD skiller sig af med sin mainframe-afdeling - 68 KMD-ansatte får ny arbejdsgiver

IBM overtager fra 1. juni den tekniske del af KMD's mainframe-forretning. Dermed får 68 KMD-medarbejdere ny arbejdsgiver.

White paper

Teaser billede

Hvordan sikrer man den virtuelle infrastruktur uden at påvirke performance?

Denne rapport udforsker nogle af de specifikke udfordringer ved virtualiseret sikkerhed, fremvise resultaterne af adskillige performance-tests udført af Bitdefender samt byde ind med et indblik i...



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