Notifikationer

Markér alle som læst Log ud

nehm Nybegynder

27. april 2012 - 11:31 Der er 7 kommentarer og
1 løsning

Loop paste celler når der er en værdi i A

En VBA code som kan lave et loop i et excel ark

Jeg har lavet en række formler i C2:AC2 dem vil jeg gerne kopier til alle rækker som har en værdi i kollone A i samme sheet

Synes godt om

store-morten Ekspert

27. april 2012 - 12:50 #1

Prøv:

Sub KopiVedTegniA()
On Error GoTo Slut
home = ActiveCell.Address
homeArk = ActiveSheet.Name

Application.ScreenUpdating = False
For Each c In ActiveSheet.Range("A3:A10").Cells 'Ret celler for indsæt
If c.Value <> "" Then
Range("C2:AC2").Copy Destination:=c.Offset(0, 2)
End If
Next c

Sheets(homeArk).Select
Range(home).Select

GoTo Slut
Slut:
Application.ScreenUpdating = True
End Sub

Synes godt om

nehm Nybegynder

28. april 2012 - 08:50 #2

Din virker, men jeg skal køre den på mellem 5000-10000 linier og det tage lang tid med denne her :-)

Er der en måde hvor man kan tælle linier i A som ikke er Blanke og så bruge det resultat i et range C3:AC(resultat) ?

Synes godt om

store-morten Ekspert

28. april 2012 - 11:30 #3

Prøv at teste denne:

Sub KopiVedTegniA_version_2()
On Error GoTo Slut
home = ActiveCell.Address
homeArk = ActiveSheet.Name

Application.ScreenUpdating = False

Columns("A:A").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$A$35").AutoFilter Field:=1, Criteria1:="<>"

Range("C3:AC3").Copy

sidste = Range("A65536").End(xlUp).Offset(0, 28).Address
Range("C3:" & sidste).Select

ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter

Sheets(homeArk).Select
Range(home).Select

GoTo Slut
Slut:
Application.ScreenUpdating = True
End Sub

Synes godt om

store-morten Ekspert

28. april 2012 - 11:51 #4

Der var så lige en række fejl.
Range("C3:AC3").Copy
Rettet til:
Range("C2:AC2").Copy

Sub KopiVedTegniA_version_2()
On Error GoTo Slut
home = ActiveCell.Address
homeArk = ActiveSheet.Name

Application.ScreenUpdating = False

Columns("A:A").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$A$35").AutoFilter Field:=1, Criteria1:="<>"

Range("C2:AC2").Copy

sidste = Range("A65536").End(xlUp).Offset(0, 28).Address
Range("C2:" & sidste).Select

ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter

Sheets(homeArk).Select
Range(home).Select

GoTo Slut
Slut:
Application.ScreenUpdating = True
End Sub

Synes godt om

store-morten Ekspert

28. april 2012 - 11:57 #5

Og linien:
ActiveSheet.Range("$A$1:$A$35").AutoFilter Field:=1, Criteria1:="<>"

Virker ;-)

Men er nok mere korrekt sådan:

ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:="<>"

Synes godt om

store-morten Ekspert

28. april 2012 - 12:11 #6

Sub KopiVedTegniA_version_2()
On Error GoTo Slut
home = ActiveCell.Address
homeArk = ActiveSheet.Name

Application.ScreenUpdating = False

Columns("A:A").Select
Selection.AutoFilter
ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:="<>"

Range("C2:AC2").Copy

sidste = Range("A65536").End(xlUp).Offset(0, 28).Address
Range("C2:" & sidste).Select

ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter

Sheets(homeArk).Select
Range(home).Select

GoTo Slut
Slut:
Application.ScreenUpdating = True
End Sub

Synes godt om

nehm Nybegynder

28. april 2012 - 13:20 #7

Den virker perfekt smid et svar :-)

Synes godt om

store-morten Ekspert

28. april 2012 - 13:27 #8

Kommer her ;-)

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

Excel kurser

Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel	Indlæg	Oprettet	Seneste aktivitet
Hvordan bruges indeks & sammenlign når der skal søges over flere kolonner? Af Laugesen1 i Excel	4	08/03/202611:56	08/03/202613:57
Tips til at mestre Excel hurtigt Af MonikaG32 i Excel	4	04/03/202617:11	06/03/202609:37
Båndet i Excel online har ændret størrelse Af Monique i Excel	3	19/02/202614:23	20/02/202608:26
Fjern tekst efter mellemrum Af ABE15 i Excel	2	18/02/202620:41	19/02/202611:30
Udskrift af ark Af boro23 i Excel	4	17/02/202608:38	18/02/202607:46

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