CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg

Log ind eller opret profil

Du kan også logge ind via nedenstående tjenester

bimmer07 Nybegynder

04. august 2015 - 10:44 Der er 12 kommentarer og
1 løsning

Kopier til næste ledige kolonne VBA

Hej

Jeg har brug for en vba kode, som kan kopiere data fra ark 1 celle c5 til c20 over i ark 2 i den næste ledige kolonne fra kolonne E.

Altså den data, der skal kopieres befinder sig altid samme sted, men den skal kopieres over i et nyt ark ( i samme dokument) til næste ledige kolonne.

jeg bruger Excel 2007.

Jeg har forsøgt mig med et par timers google søgning, og afprøvning af diverse formler, men har endnu ikke fundet det helt rigtige.

Så håber at nogle kan hjælpe!:-)

Tak

/Kim

Synes godt om

store-morten Ekspert

04. august 2015 - 12:32 #1

Prøv:

Sub FlytData()
Sheets("Ark1").Range("C2:C20").Copy
Sheets("Ark2").Activate
Sheets("Ark2").Cells(2, 10000).End(xlToLeft).Offset(0, 1).Select
If ActiveCell.Column = 2 Then
ActiveCell.Offset(0, 3).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

Synes godt om

store-morten Ekspert

04. august 2015 - 16:02 #2

= 2 rettet til < 4

Sub FlytData()
Sheets("Ark1").Range("C2:C20").Copy
Sheets("Ark2").Activate
Sheets("Ark2").Cells(2, 10000).End(xlToLeft).Offset(0, 1).Select
If ActiveCell.Column < 4 Then
ActiveCell.Offset(0, 3).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

Eller:

Sub FlytData2()
If Sheets("Ark2").Cells(2, 10000).End(xlToLeft).Offset(0, 1).Column <= 4 Then
Indkol = 5
Else
Indkol = Sheets("Ark2").Cells(2, 10000).End(xlToLeft).Offset(0, 1).Column
End If
Sheets("Ark1").Range("C2:C20").Copy _
Destination:=Sheets("Ark2").Cells(2, Indkol)
Application.CutCopyMode = False
End Sub

Synes godt om

store-morten Ekspert

04. august 2015 - 16:25 #3

Og rettet til C5 i stedet fo C2

Sub FlytData()
Sheets("Ark1").Range("C5:C20").Copy
Sheets("Ark2").Activate
Sheets("Ark2").Cells(5, 10000).End(xlToLeft).Offset(0, 1).Select
If ActiveCell.Column < 4 Then
ActiveCell.Offset(0, 3).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

Sub FlytData2()
If Sheets("Ark2").Cells(5, 10000).End(xlToLeft).Offset(0, 1).Column <= 4 Then
Indkol = 5
Else
Indkol = Sheets("Ark2").Cells(5, 10000).End(xlToLeft).Offset(0, 1).Column
End If
Sheets("Ark1").Range("C5:C20").Copy _
Destination:=Sheets("Ark2").Cells(5, Indkol)
Application.CutCopyMode = False
End Sub

Synes godt om

bimmer07 Nybegynder

05. august 2015 - 10:19 #4

Hej Store-morten

Det er tæt på, at det virker efter hensigten:-)
Eneste der ikke virker, er at når man kører makroen igen, skal den sætte data ind i den næste ledige kolonne efter kolonne E. Så hvis der står noget i kolonne E skal den sætte data ind i kolonne F. Hvis der står noget i kolonne F skal den sætte data ind i G osv.

Giver det mening, og tak for hjælpen indtil videre!

Synes godt om

bimmer07 Nybegynder

05. august 2015 - 10:31 #5

og iøvrigt er det dine rettede udgaver, der næsten virker.

Synes godt om

store-morten Ekspert

05. august 2015 - 11:40 #6

Det kræver at der altid er data i celle C5, er det ikke tilfældet?

Synes godt om

store-morten Ekspert

05. august 2015 - 12:05 #7

Kan der evt. sættes i tidsstempel på Ark2 for overførsel i række 4 ?

Formater evt. Ark2 række 4 med klokkeslæt, ved at markere cellen ses også dato i formel-linien.

Sub FlytData2()
If Sheets("Ark2").Cells(4, 10000).End(xlToLeft).Offset(0, 1).Column <= 4 Then
Indkol = 5
Else
Indkol = Sheets("Ark2").Cells(4, 10000).End(xlToLeft).Offset(0, 1).Column
End If
Sheets("Ark1").Range("C5:C20").Copy _
Destination:=Sheets("Ark2").Cells(5, Indkol)
Application.CutCopyMode = False
Sheets("Ark2").Cells(4, Indkol) = Now
End Sub

Synes godt om

bimmer07 Nybegynder

05. august 2015 - 12:20 #8

der er altid data i celle c5 i ark 1!?

Det duer ikke med datoformatering.Selvom din makro dog virker til at kopiere data ind i række 4 i næste ledige kolonne. det skal være al data fra ark 1 celle c5 til c20 der skal kopieres over.

Synes godt om

store-morten Ekspert

05. august 2015 - 15:16 #9

Gør den ikke det?

Prøv:

Sub FlytData3()
' Tjekker om C5 på Ark1 er udfyldt
If IsEmpty(Sheets("Ark1").Range("C5")) Then
MsgBox "Husk der skal være data i celle C5", vbOKOnly + vbInformation
Cancel = True
Exit Sub
End If
'Tjekker om første tomme kollonne er mindre en 5, ellers sættes den til 5 (E)
If Sheets("Ark2").Cells(5, 10000).End(xlToLeft).Offset(0, 1).Column <= 4 Then
Indkol = 5
Else
'Hvis større end 4, findes første tomme kollonne
Indkol = Sheets("Ark2").Cells(5, 10000).End(xlToLeft).Offset(0, 1).Column
End If
'Kopiere C5:C20 på Ark1
Sheets("Ark1").Range("C5:C20").Copy _
Destination:=Sheets("Ark2").Cells(5, Indkol)
'og sætter ind på Ark2 i næste tomme kollone
End Sub

Se:
www.http://gratisupload.dk/f/8swjcqt8vi/

Synes godt om

bimmer07 Nybegynder

07. august 2015 - 14:43 #10

Yes sir, så virker den. Tak for hjælpen!

Synes godt om

bimmer07 Nybegynder

07. august 2015 - 14:43 #11

Yes sir, så virker den. Tak for hjælpen!

Synes godt om

bimmer07 Nybegynder

07. august 2015 - 14:45 #12

Ah, jeg kager lidt rundt. Sender et svar, så jeg kan give dig point?

Synes godt om

store-morten Ekspert

07. august 2015 - 14:47 #13

Det i orden ;-)
Velbekomme

Synes godt om

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.

Følg dette spørgsmål

Opret Preview

Flere spørgsmål fra Visual Basic kategorien

Titel	Indlæg	Oprettet	Seneste aktivitet
overskrive datasæt hvis det allerede eksistere Af overisen i Visual Basic	0	08/12/202320:00	-
Manuel rotering af billedfil i en formular, 90 - 180 - 270 - 360 grader Af stejuu i Visual Basic	2	04/12/202320:07	09/12/202310:49
Erstat http med faktisk billede Af crjensen i Visual Basic	0	09/10/202309:14	-
Filtrering af dato i Pivottabel driller Af TrinoJ. i Visual Basic	4	07/08/202310:40	10/08/202310:44
Konvertere tabeller til tekst Af crjensen i Visual Basic	1	10/07/202311:43	10/07/202312:37

Se alle spørgsmål i kategorien Opret spørgsmål

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

Alle kategorier på Eksperten

Seneste artiklerRSS