Workbook select

Status
Niet open voor verdere reacties.

Niels28

Terugkerende gebruiker
Lid geworden
20 nov 2008
Berichten
2.492
Hallo,

Ik heb een userform gemaakt om een aantal gevens in excel in te vullen.
Van de gegevens in cel A1 en cel H1 wordt een map aangemaakt en een bestand in die map gekopieerd.
De gegevens van cel A1 worden automatisch ingevuld, H1 moeten mijn colegga's zelf invullen.
Omdat ze de gegevens die ze hier in moeten vullen niet altijd weten heb ik een knop op het userform gezet om de lijst waar deze gegevens instaan te openen.
Ik heb het userform op ShowModal = false gezet zodat ze in deze lijst kunnen zoeken.
De gegevens van het userform worden verwerkt als er op OKE wordt gedrukt.
Dit werkt allemaal goed behalve als ze in de andere lijst zitten.
Hoe kan ik er voor zorgen dat de macro ook werkt als ze in een andere werkmappen zijn?

Niels

Code:
Private Sub CommandButton1_Click()
     

Workbooks.Open Filename:=("F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\klantnummers.xls")
   
End Sub

Private Sub UserForm_Activate()
TextBox1.Value = Worksheets(2).Range("A2").Value

End Sub

Private Sub OKE_Click()
'onderstaande macro uitvoeren als er op OK wordt geklikt'
'gegevens formulieren overnemen in desbetreffende cellen'

Sheets("kopieblad").Cells(1, 2).Value = Me.TextBox2.Value
Sheets("kopieblad").Cells(1, 3).Value = Me.TextBox3.Value
Sheets("kopieblad").Cells(1, 4).Value = Me.TextBox4.Value
Sheets("kopieblad").Cells(1, 5).Value = Me.TextBox5.Value
Sheets("kopieblad").Cells(1, 6).Value = Me.TextBox6.Value
Sheets("kopieblad").Cells(1, 7).Value = Me.TextBox7.Value
Sheets("kopieblad").Cells(1, 8).Value = Me.TextBox10.Value
Sheets("kopieblad").Cells(1, 9).Value = Me.TextBox8.Value
Sheets("kopieblad").Cells(1, 10).Value = Me.TextBox9.Value

Unload Me
    
    
'controleren of folder bestaat anders folder aanmaken met naam uit cel A1'
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists("F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\" & Sheets("kopieblad").Range("a1").Value & "\") Then .CreateFolder "F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\" & Sheets("kopieblad").Range("a1").Value & "\"
End With
    
'van cel A1 hyperlink maken'
Sheets("kopieblad").Select
Range("A1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\" & Sheets("kopieblad").Range("A1").Value & "\"
    
'controleren of bestand bestaat anders bestand kopieeren vanuit opgegeven folder en plakken in aangemaakte folder onder naam uit cel C16'
With CreateObject("Scripting.FileSystemObject")
If Not .FileExists("F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\" & Sheets("kopieblad").Range("a1").Value & "\Acquisitie " & Sheets("kopieblad").Range("a1").Value & ".xls") Then FileCopy ("F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\sjabloon projecten.xls"), ("F:\data\verkoop\algemeen\acquisitie\acquisitie projecten\" & Sheets("kopieblad").Range("a1").Value & "\Acquisitie " & Sheets("kopieblad").Range("a1").Value & ".xls")
End With

'als cel H1 leeg is macro afsluiten'
If Sheets("kopieblad").Range("H1") = "" Then GoTo Kopieëren
'controleren of folder bestaat anders folder aanmaken met naam uit cel H1'
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists("F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\" & Sheets("kopieblad").Range("H1").Value & "\") Then .CreateFolder "F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\" & Sheets("kopieblad").Range("H1").Value & "\"
End With
   
'van cel H1 hyperlink maken'
Sheets("kopieblad").Select
Range("H1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\" & Sheets("kopieblad").Range("H1").Value & "\"
    
'controleren of bestand bestaat anders bestand kopieeren vanuit opgegeven folder en plakken in aangemaakte folder onder naam uit cel C16'
With CreateObject("Scripting.FileSystemObject")
If Not .FileExists("F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\" & Sheets("kopieblad").Range("h1").Value & "\Acquisitie " & Sheets("kopieblad").Range("h1").Value & ".xls") Then FileCopy ("F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\sjabloon.xls"), ("F:\data\verkoop\algemeen\acquisitie\acquisitie accounts\" & Sheets("kopieblad").Range("h1").Value & "\Account " & Sheets("kopieblad").Range("H1").Value & ".xls")
End With


Kopieëren:
    'rij 1 kopiëren van blad2'
    Sheets("kopieblad").Rows("1:1").Select
    Selection.Copy
    'cel met opvolgend nummer zoeken en rij invoegen boven geselecteerde cel'
    Sheets("overzichtslijst").Select
    Cells((Range("j1").Value), 2).Select
    ActiveCell.EntireRow.Insert Shift:=xlDown
    ActiveCell.Select

End Sub


Private Sub CANCEL_Click()
Unload Me
End Sub
 
Heb het al gevonden,
moest de volgende code er tussen zetten

Code:
Workbooks("overzicht nummers.xls").Activate
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan