Avatar billede dane022 Seniormester
22. april 2014 - 10:58 Der er 10 kommentarer og
1 løsning

VBA: kopier række til nyt ark

Jeg mangler en vba kode til at kopiere data fra et ark til et andet.

Jeg har en liste med 4 kolonner som skal kopieres. Det skal foregå på den måde, at hver rækkes 4 celler skal kopieres til det andet ark men ved siden af hinanden.

1) Ark1: a1, b1, c1 og d1 kopieres til ark2: a1, b1, c1 og d1.
2) Ark1: a2, b2, c2 og d2 kopieres til ark2: e1, f1, g1 og h1.

Dette gentages, men kun indtil (og her kommer det svære) data i ark1 kolonne D ændrer sig. Herefter startes på ny linje på ark2.

Håber det er til at forstå
Avatar billede supertekst Ekspert
22. april 2014 - 14:23 #1
Hvis du har en lille model af din fil er du velkommen til at fremsende den. @-adresse under min profil.
Avatar billede supertekst Ekspert
22. april 2014 - 14:50 #2
Her er et udspil du kan afprøve. Anbringes under ark1. Kan igangsættes via Alt+F8 / Afspil makro

Rem Ark1
Dim antalRæk As Integer
Dim ræk As Integer, kolD As Variant

Rem Ark2
Dim ræk2 As Integer, kol2 As Integer
Public Sub samlingPåArk2()
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    ræk2 = 1
    kolD = Range("D1")
   
    For ræk = 1 To antalRæk
        If ræk = 1 Then
            kolD = Range("D1")
            kol2 = 1
        Else
            If Range("D" & ræk) = kolD Then
                kol2 = kol2 + 4
            Else
                kol2 = 1
                ræk2 = ræk2 + 1
            End If
        End If
        flytTilArk2
    Next ræk
End Sub
Private Sub flytTilArk2()
    With ActiveWorkbook.Sheets(1)
        .Range("A" & ræk & ":D" & ræk).Select
        Selection.Copy
       
        ActiveWorkbook.Sheets(2).Select
        ActiveSheet.Cells(ræk2, kol2).Select
        ActiveSheet.Paste
       
    End With
   
    ActiveWorkbook.Sheets(1).Select
    Application.CutCopyMode = False
End Sub
Avatar billede dane022 Seniormester
22. april 2014 - 15:17 #3
Jeg har lagt hele koden under ark1. Når jeg kører den via makroer, så sker der ikke noget. Hvis jeg til gengæld går ind i koden og holder f8 nede så begynder den at køre koden igennem og kopiere cellerne.

Det virker næsten som det skal. Når koden når til at data i kolonne 4 ændrer sig, begynder den at kopiere nedaf istedet.

Vil du stadig have regneark tilsendt?
Avatar billede supertekst Ekspert
22. april 2014 - 15:24 #4
Som nævnt i #2 kan du eksekvere koden via Alt+F8 m.v.

Jeg retter lige - har glemt at flytte værdi, når D skifter indhold.

Vender tilbage..
Avatar billede supertekst Ekspert
22. april 2014 - 15:27 #5
Rem Version 2
Rem Ark1
Dim antalRæk As Integer
Dim ræk As Integer, kolD As Variant

Rem Ark2
Dim ræk2 As Integer, kol2 As Integer
Public Sub samlingPåArk2()
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    ræk2 = 1
    kolD = Range("D1")
   
    For ræk = 1 To antalRæk
        If ræk = 1 Then
            kolD = Range("D1")
            kol2 = 1
        Else
            If Range("D" & ræk) = kolD Then
                kol2 = kol2 + 4
            Else
                kol2 = 1
                ræk2 = ræk2 + 1
                kolD = Range("D" & ræk)            'tilføjelse i version 2
            End If
        End If
        flytTilArk2
    Next ræk
End Sub
Private Sub flytTilArk2()
    With ActiveWorkbook.Sheets(1)
        .Range("A" & ræk & ":D" & ræk).Select
        Selection.Copy
       
        ActiveWorkbook.Sheets(2).Select
        ActiveSheet.Cells(ræk2, kol2).Select
        ActiveSheet.Paste
       
    End With
   
    ActiveWorkbook.Sheets(1).Select
    Application.CutCopyMode = False
End Sub
Avatar billede dane022 Seniormester
28. april 2014 - 17:52 #6
Jeg havde ikke fået mail om dit indlæg, så jeg har først set det nu. Er der en metode til at koden kan køres uden genvejstast?
Avatar billede supertekst Ekspert
28. april 2014 - 18:18 #7
Ok - ja - hvis du beskriver hvordan du ønsker det. F.eks. via en knap eller et spørgsmål når filen åbnes eller ??
Avatar billede dane022 Seniormester
28. april 2014 - 20:05 #8
Det vil være fint hvis den kan køres fra listen over makroer
Avatar billede supertekst Ekspert
28. april 2014 - 22:58 #9
Ikke forstået..
Avatar billede dane022 Seniormester
29. april 2014 - 21:54 #10
Ikke noget alligevel, det fungerer som det skal
Avatar billede supertekst Ekspert
29. april 2014 - 22:51 #11
Ok..
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester