Vereenvoudigen van code

[weusty]

Hoe kan het onderstaande makkelijke worden geschreven?

De eerste Range gaat uiteindelijk tot 'BN1', en de tweede Range gaat uiteindelijk tot 'A60'

Om een hoop typewerk te voorkomen zou ik het onderstaande dus was compacter willen omschrijven.

Sub Macro1()
' Settings
    Dim MyName As Workbook
    Set MyName = ActiveWorkbook
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

' Openen
    ChDir "Q:\Archief Urenlijst\Users"
    Workbooks.Open Filename:="Q:\Archief Urenlijst\Users\Users.xls"
    ActiveSheet.Unprotect
       
'namen invoegen
    MyName.Sheets("LEEG").Range("H1").Value = Workbooks("Users").Sheets("Blad1").Range("A2").Value

    MyName.Sheets("LEEG").Range("I1").Value = Workbooks("Users").Sheets("Blad1").Range("A3").Value

    MyName.Sheets("LEEG").Range("J1").Value = Workbooks("Users").Sheets("Blad1").Range("A4").Value

    MyName.Sheets("LEEG").Range("K1").Value = Workbooks("Users").Sheets("Blad1").Range("A5").Value
  
    ActiveWindow.Close
    
End Sub

Alvast bedankt voor uw aandacht.


PS. Als ik het juiste antwoord heb, zal ik een betere titel verzinnen.

Groet,

 

[danny147]

Beste weusty

Beetje aangepast.

Sub Macro1()
' Settings
    Dim MyName As Workbook
    Set MyName = ActiveWorkbook
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

' Openen
    ChDir "Q:\Archief Urenlijst\Users"
    Workbooks.Open Filename:="Q:\Archief Urenlijst\Users\Users.xls"
    ActiveSheet.Unprotect
       
'namen invoegen
    MyName.Sheets("LEEG").[H1] = Workbooks("Users").Sheets("Blad1").[A2]
    MyName.Sheets("LEEG").[I1] = Workbooks("Users").Sheets("Blad1").[A3]
    MyName.Sheets("LEEG").[J1] = Workbooks("Users").Sheets("Blad1").[A4]
    MyName.Sheets("LEEG").[K1] = Workbooks("Users").Sheets("Blad1").[A5]

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
  
    ActiveWindow.Close
    
End Sub

Je beveiliging heb je uitgezet, moet ge deze niet terug op protect zetten.
Ze zal nog wel een stuk kunnen vereenvoudigen.

Groetjes Danny. :thumb:

 

[Wigi]

Eerst een Copy op het bereik doen in kolom 1, dan een PasteSpecial met Transpose op de plaats waar het moet komen.

Wigi

 

[trucker10]

Het kan korter in de richting van

Workbooks("MyName").Sheets("LEEG").Range("H1:BN1").Copy

Sheets("Users").Activate
Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

 

[Warme bakkertje]

Ik dacht eerder in deze richting

Sub Macro1()
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
' Openen
    Workbooks.Open "Q:\Archief Urenlijst\Users\Users.xls"
    ActiveSheet.Unprotect
'namen invoegen
    [Blad1!A2:A60].Copy
    ThisWorkbook.Sheets("Leeg").[H1].PasteSpecial xlPasteValues, , , True
    With Application
        .CutCopyMode = False
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    ActiveWindow.Close False
End Sub