Dansk Regneark Forum
  Hjælp Hjælp  Søg i forum   Arrangementer   Opret ny bruger Opret ny bruger  Log ind Log ind


Emne lukketData kopiering
 Besvar Besvar
Forfatter
  Emne Søg Emne Søg  Emne funktioner Emne funktioner
Goldie Se dropdown
Forum Begynder
Forum Begynder
Avatar

Medlem: 14.Jan.2011
Land: Danmark
Status: Offline
Point: 17 		Direkte link til dette indlæg Emne: Data kopiering
    Sendt: 14.Jan.2011 kl. 17:14

Jeg sidder i øjeblikket med et ønske om at kunne kopiere visse data fra et ark til et andet ark i samme projektmappe.

Arket "Master" indeholder alle data.
De rækker som indeholder Printer i kolonne A skal kopieres til arket "Printer" Server til arket "Server" o.s.v.
jeg har vedhæftet ën testfil. ( en enkelt celle kan jeg godt finde ud af (hvis formel) men det er hele rækken der skal kopieres)
Jeg har forgæves søgt på nettet men ikke været i stand til at finde noget der virker. Derfor håber jeg der er en der kan hjælpe eller fortælle at det ikke kan lade sig gøre.
På forhånd tak
Til top



Til top
Allan Se dropdown
Forum Admin
Forum Admin
Avatar
Forum Admin

Medlem: 03.Feb.2010
Land: Danmark
Status: Offline
Point: 10330 		Direkte link til dette indlæg Sendt: 15.Jan.2011 kl. 01:17
Hej Goldie,
 
Jeg ved ikke om du er bekendt med VBA, men denne lille stump kan løse dit problem.
For hver gang den møder et navn i kolonne A på arket "Master", kopieres hele rækken til arket med samme navn.
Hvis du opretter nye ark med nye navne, vil koden automatisk tage højde for det, det enske ark som er fast kodet er "Master".
 
Sub KopierTilFaner()
Application.ScreenUpdating = False
For Each c In Sheets("Master").Range("A1:A100").Cells
    If c.Value <> "" Then
        On Error Resume Next
        If Sheets(c.Value) Is Nothing Then
        Else
        On Error GoTo 0
            c.EntireRow.Copy
            Sheets(c.Value).Activate
            Range("A100").End(xlUp).Offset(1, 0).Select
            ActiveSheet.Paste
        End If
    End If
Next c
Application.CutCopyMode = False
Sheets("Master").Select
End Sub
Skal du have hjælpe til at lægge koden i dit fil?
 
//Allan
Til top
rassten Se dropdown
Guld bruger
Guld bruger


Medlem: 26.Okt.2010
Status: Offline
Point: 694 		Direkte link til dette indlæg Sendt: 15.Jan.2011 kl. 02:12
En metode kunne være

Sub a_test()
Sheets("Master").Activate
LR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LR Step 1
    If Cells(i, 1).Value = "Server" Then
    Rows(i).Copy Destination:=Worksheets("Server").Range("a" & 1 + (Worksheets("Server").Cells(Rows.Count, 1).End(xlUp).Row))
    ElseIf Cells(i, 1).Value = "Printer" Then
    Rows(i).Copy Destination:=Worksheets("Printer").Range("a" & 1 + (Worksheets("Printer").Cells(Rows.Count, 1).End(xlUp).Row))
    ElseIf Cells(i, 1).Value = "Disk" Then
    Rows(i).Copy Destination:=Worksheets("Disk").Range("a" & 1 + (Worksheets("Disk").Cells(Rows.Count, 1).End(xlUp).Row))
    
End If

Next i
End Sub



Men ellers kan du også altid bruge "filter" metoden
Til top
Goldie Se dropdown
Forum Begynder
Forum Begynder
Avatar

Medlem: 14.Jan.2011
Land: Danmark
Status: Offline
Point: 17 		Direkte link til dette indlæg Sendt: 16.Jan.2011 kl. 08:57
Hej Allan
Mange tak for svaret.
Nej jeg er ikke en haj til VBA men har lagt din kode ind i Arket master. Det er desværre ikke lykkedes for mig at få det til at køre .
Error Run-Time Error '1004':
Application-defined or object-defined error
//Goldie
 
Til top
Goldie Se dropdown
Forum Begynder
Forum Begynder
Avatar

Medlem: 14.Jan.2011
Land: Danmark
Status: Offline
Point: 17 		Direkte link til dette indlæg Sendt: 16.Jan.2011 kl. 09:00
Hej Rassten
Jeg takker også dig for svaret..
Jeg har også prøvet dit forslag.. Fungerer men.....
For hver gang jeg kører dit script bliver de relevante rækker kopieret. Kan det lade sig gøre at det kun bliver gjort en gang.
//Goldie
Til top
rassten Se dropdown
Guld bruger
Guld bruger


Medlem: 26.Okt.2010
Status: Offline
Point: 694 		Direkte link til dette indlæg Sendt: 16.Jan.2011 kl. 12:22
Error Run-Time Error '1004':
Application-defined or object-defined error

Skyldes at du har lagt koden det forkerte sted.
I vba-editoren vælg menuen "Insert" - vælg "Module", her skal koden så indsættes
Til top
rassten Se dropdown
Guld bruger
Guld bruger


Medlem: 26.Okt.2010
Status: Offline
Point: 694 		Direkte link til dette indlæg Sendt: 16.Jan.2011 kl. 12:40
Denne gør at data på arkene Server osv. bliver slettet

Sub a_1_test()
Application.ScreenUpdating = False
Sheets("Server").Activate
LR = Cells(Rows.Count, 1).End(xlUp).Row
If LR > 2 Then Rows("2:" & LR).ClearContents

Sheets("Printer").Activate
LR = Cells(Rows.Count, 1).End(xlUp).Row
If LR > 2 Then Rows("2:" & LR).ClearContents

Sheets("Disk").Activate
LR = Cells(Rows.Count, 1).End(xlUp).Row
If LR > 2 Then Rows("2:" & LR).ClearContents


Sheets("Master").Activate
LR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LR Step 1
    If Cells(i, 1).Value = "Server" Then
    Rows(i).Copy Destination:=Worksheets("Server").Range("a" & 1 + (Worksheets("Server").Cells(Rows.Count, 1).End(xlUp).Row))
    ElseIf Cells(i, 1).Value = "Printer" Then
    Rows(i).Copy Destination:=Worksheets("Printer").Range("a" & 1 + (Worksheets("Printer").Cells(Rows.Count, 1).End(xlUp).Row))
    ElseIf Cells(i, 1).Value = "Disk" Then
    Rows(i).Copy Destination:=Worksheets("Disk").Range("a" & 1 + (Worksheets("Disk").Cells(Rows.Count, 1).End(xlUp).Row))
    
End If
Next i
Application.ScreenUpdating = True
End Sub
Til top
rassten Se dropdown
Guld bruger
Guld bruger


Medlem: 26.Okt.2010
Status: Offline
Point: 694 		Direkte link til dette indlæg Sendt: 16.Jan.2011 kl. 13:49
Denne variant sletter ikke noget.
Men bruger kolonne AA som hjælpe kolonne. De allerede flyttede data bliver i kolonne AA markeret med et "x", så kun de rækker som der ikke i kolonne AA er markeret med et "x" bliver flyttet næst gang makroen kører.
Bemærk at kolonne AA bliver skjult 


Sub a_2_test()
Application.ScreenUpdating = False

Sheets("Master").Activate
Columns("AA:AA").EntireColumn.Hidden = False
FR = Cells(Rows.Count, 1).End(xlUp).Row
For a = FR To 2 Step -1
    If Range("AA" & a) = "x" Then
    Rows(a).EntireRow.Hidden = True
    End If
Next a

LR = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LR Step 1
    If Cells(i, 1).Value = "Server" Then
    Rows(i).Copy Destination:=Worksheets("Server").Range("a" & 1 + (Worksheets("Server").Cells(Rows.Count, 1).End(xlUp).Row))
    ElseIf Cells(i, 1).Value = "Printer" Then
    Rows(i).Copy Destination:=Worksheets("Printer").Range("a" & 1 + (Worksheets("Printer").Cells(Rows.Count, 1).End(xlUp).Row))
    ElseIf Cells(i, 1).Value = "Disk" Then
    Rows(i).Copy Destination:=Worksheets("Disk").Range("a" & 1 + (Worksheets("Disk").Cells(Rows.Count, 1).End(xlUp).Row))
    
End If
Next i

Range("AA2:AA" & FR).EntireRow.Hidden = False
Range("AA2:AA" & FR) = "x"
Columns("AA:AA").EntireColumn.Hidden = True

Application.ScreenUpdating = True
End Sub
Til top
Allan Se dropdown
Forum Admin
Forum Admin
Avatar
Forum Admin

Medlem: 03.Feb.2010
Land: Danmark
Status: Offline
Point: 10330 		Direkte link til dette indlæg Sendt: 16.Jan.2011 kl. 20:04
Hej Goldie,
 
Prøv lige at se denne fil, jeg har forsynet funktionen med en knap på arket 'Master' som du kan teste funktionen med.
Den virker ved at alle data på arkene 'Server', 'Printer' og 'Disk' bliver slettet inden data kopieres over.
Derefter køres funktionen så alle rækker kopieres over på det ark som matcher navnet i cellerne.
 
 
Kan dette løse din udfordring?
 
//Allan
Til top
Goldie Se dropdown
Forum Begynder
Forum Begynder
Avatar

Medlem: 14.Jan.2011
Land: Danmark
Status: Offline
Point: 17 		Direkte link til dette indlæg Sendt: 17.Jan.2011 kl. 10:57
Hej
Super... det er lige det der løser opgaven..
 
Jeg takker mange gange jer begge for svar..
//Goldie
Til top
Allan Se dropdown
Forum Admin
Forum Admin
Avatar
Forum Admin

Medlem: 03.Feb.2010
Land: Danmark
Status: Offline
Point: 10330 		Direkte link til dette indlæg Sendt: 17.Jan.2011 kl. 17:17
Hej Goldie,
 
50% velbekomme herfra Wink
Tak for din tilbagemelding.
 
//Allan
MVH

Allan
Excel-regneark.dk - Gratis skabeloner til Excel
Få over 120 ekstra funktioner med Danmarks bedste add-in
Til top
 Besvar Besvar

Skift forum Forum tilladelser Se dropdown

© 2010 - 2024 Dansk Regneark Forum - en del af Excel-regneark.dk