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
HVIS + LOPSLAG til flere værdier Af SQF i Excel	4	09/10/202510:50	14/10/202516:09
Finde uger og dage mellem 2 datoer Af mefa i Excel	9	08/10/202519:21	10/10/202505:05
Excel Makroer programmering bit32 - bit64 Af bhh i Excel	3	01/10/202512:22	03/10/202513:32
Eliminer kendte Af andershl i Excel	1	30/09/202520:40	01/10/202512:54
Numering af række efter størst til mindst Af Excel Optimisten i Excel	4	30/09/202512:56	30/09/202514:23

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