Søg
Avatar billede 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
Avatar billede 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
Avatar billede 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) ?
Avatar billede 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
Avatar billede 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
Avatar billede 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:="<>"
Avatar billede 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
Avatar billede nehm Nybegynder
28. april 2012 - 13:20 #7
Den virker perfekt smid et svar :-)
Avatar billede store-morten Ekspert
28. april 2012 - 13:27 #8
Kommer her ;-)
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
Kategori
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
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
Aktiedepoter Af rabitjosph i Excel 6 12/02/202615:31 16/02/202613:21
Fejl i hver anden celle Af AOT1977 i Excel 2 11/02/202621:19 12/02/202606:21
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.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I går 16:27 Forskellen på originalt og uoriginalt blæk Af vbr i Printere
I går 09:34 overføre billeder fra android tablet til pc Af Malm i Windows
27/0211:38 Netværksadgang for flere brugere til samme filer på Ubuntu Server Af Strawberry i Linux
26/0207:23 Mine gemte billeder er korrupte Af hans01 i Billedbehandling
25/0222:27 Antal enheder i samme stikkontakt ? Af GHQ i Andet hardware
White papers
Flere white papers »