VBA werkt niet

bascas · 27 jun 2011

Hallo, in onderstaand document kun je op tabblad "voorblad" in kolom A een naam invoeren, vervolgens wordt er een tabblad aangemaakt met die naam. Maar als je op dat tabblad de naam weghaalt met delete, dan maakt hij weer een blad aan en start de foutopsporing, dat zou niet moeten. En... de uitkomst van K2 en K3 van de aangemaakte tabbladen zou op het " voorblad" terecht moeten komen ( automatisch), maar weet niet hoe?

Groetjes Bas

Bekijk bijlage Leveranciers overzicht.xls

HSV · 27 jun 2011

Je eerste vraag.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column = 1 And Target <> "" Then
  Sheets.Add(after:=Sheets(Sheets.Count)).Name = Target
   Sheets("pepsi").Range("1:5").Copy ActiveSheet.Range("1:5")
 End If
End Sub

Moet er morgen weer vroeg af, dus geen tijd meer.

Elsendoorn2134 · 27 jun 2011

En hier heb je de rest van de code

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target <> "" Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = Target
Sheets("pepsi").Range("1:5").Copy ActiveSheet.Range("1:5")
Sheets("Voorblad").Range(Target.Address).Offset(0, 3) = "=" & Target & "!$K$2"
Sheets("Voorblad").Range(Target.Address).Offset(0, 4) = "=" & Target & "!$K$3"
End If

End Sub

Veel succes

bascas · 28 jun 2011

Bedankt heren, waar zou ik dat stukje tekst de volgende code neer moeten zetten? Range("B2")=activesheet.name

ExcelAmateur · 28 jun 2011

bascas,

Die zou je b.v.b. achter het blad kunnen zetten.

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Range("B2") = ActiveSheet.Name
End Sub

HSV · 28 jun 2011

Of.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 And Target <> "" Then
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = Target
     Sheets("pepsi").Range("1:5").Copy ActiveSheet.Range("1:5")
      ActiveSheet.Range("B2") = ActiveSheet.Name
     Sheets("Voorblad").Range(Target.Address).Offset(0, 3) = "=" & Target & "!$K$2"
    Sheets("Voorblad").Range(Target.Address).Offset(0, 4) = "=" & Target & "!$K$3"
  End If
End Sub

bascas · 28 jun 2011

Bedankt, nu verandert alleen nog kolom C van tabblad " voorblad" als ik daar met de delete knop iets weghaal. Die zou dus een vaste waarde moeten hebben/houden.

HSV · 28 jun 2011

Is het nu een verwijzing?
Graag wat meer informatie, of je bestandje uploaden.

bascas · 28 jun 2011

Stel je hebt een tabblad gemaakt op het voorblad, maar dat is niet goed. En je verwijdert het tabblad, en je haalt de tekst op het voorblad weg met delete, dan past hij de grote aan van kolom C. Hoop dat het zo iets duidelijker is.
Groet Bas

Bekijk bijlage Leveranciers overzicht1.xls

HSV · 28 jun 2011

Het laatste stukje van de code.

Code:

For i = 1 To 7
  If ActiveSheet.Name <> "Voorblad" Then
    ActiveSheet.Columns(i).ColumnWidth = Sheets("pepsi").Columns(i).ColumnWidth
   End If
  Next
End Sub

bascas · 1 jul 2011

Nog een verzoek, nu plaatst het stukje script een tabblad na het tabblad "pepsi" , en dan weer na die , enz enz, zou dat ook op alfabet kunnen?En hoe zou de code dan worden.

Groet Bas

Warme bakkertje · 1 jul 2011

Code:

Sub SortSheets()
   Application.ScreenUpdating = False
   Dim i As Integer, J As Integer

   For i = 1 To Sheets.Count - 1  'Aantal tabbladen die aanwezig zijn / Pak 1 tabblad
      For J = i + 1 To Sheets.Count ' Pak 1 tabblad verder
         If UCase(Sheets(i).Name) > UCase(Sheets(J).Name) Then 'Als tablad 1 groter in alfabet is dan tabblad 2
            Sheets(J).Move before:=Sheets(i) 'wissel deze om
         End If
     Next J
  Next i
  Sheets("Voorblad").Move before:=Sheets(1)
End Sub

bascas · 1 jul 2011

Warm Bakkertje,
waar zou die code in moeten, dit is wat ik al heb.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target <> "" Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = Target
Sheets("blanco").Range("1:5").Copy ActiveSheet.Range("1:5")
ActiveSheet.Range("B2") = ActiveSheet.Name
Sheets("Voorblad").Range(Target.Address).Offset(0, 1) = "=" & Target & "!$F$2"
Sheets("Voorblad").Range(Target.Address).Offset(0, 2) = "=" & Target & "!$F$3"
End If
For i = 1 To 6
   ActiveSheet.Columns(i).ColumnWidth = Sheets("blanco").Columns(i).ColumnWidth
   Next
End Sub

Ik ben echt geen held in VBA.

groetjes Bas

Warme bakkertje · 2 jul 2011

Zet de code in een standaardmodule (Invoegen Module)
Zet in de code die je nu al hebt tussen Next en End Sub dan SortSheets
Telkens je macro een nieuw blad aanmaakt zal dan ook automatisch gesorteerd worden.

bascas · 2 jul 2011

Rudi, het is gelukt, maar ik krijg nog een foutmelding bij het uitvoeren van de macro. En de beveiliging wordt niet gekopieerd van het blad " blanco". Wat zou dat kunnen zijn?

Groetjes Bas

Bekijk bijlage Leveranciers_overzicht1.xls

HSV · 2 jul 2011

Zo dan Bas.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False
   If Target.Column = 1 And Target <> "" Then
     Sheets.Add(after:=Sheets(Sheets.Count)).Name = Target
      Sheets("blanco").Range("1:5").Copy ActiveSheet.Range("1:5")
     ActiveSheet.Range("B2") = ActiveSheet.Name
    End If
 For i = 1 To 7
   ActiveSheet.Columns(i).ColumnWidth = Sheets("blanco").Columns(i).ColumnWidth
 Next
    Sheets("Voorblad").Range(Target.Address).Offset(0, 1) = "=" & Target & "!$G$2"
    Sheets("Voorblad").Range(Target.Address).Offset(0, 2) = "=" & Target & "!$G$3"
   Application.EnableEvents = True
 SortSheets
End Sub

bascas · 3 jul 2011

Harry, met deze code maakt hij geen tabbladen meer aan. Ik heb het anders gedaan, en het werkt nu. Maar..in de naam die op " voorblad" wordt getypt in een cel in kolom A, mag geen komma of een spatie zitten, dat levert een script error op. Zou daar nog iets voor zijn, of moet ik gewoon de naam aanpassen?
Groet Bas

Warme bakkertje · 3 jul 2011

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo TheEnd
Application.EnableEvents = False
  If Target.Column = 1 And Target <> "" Then
     With Sheets.Add(Sheets(Sheets.Count))
        .Name = Target
        Sheets("blanco").Range("1:5").Copy .Range("1:5")
        .Range("B2") = .Name
        For i = 1 To 7
            .Columns(i).ColumnWidth = Sheets("blanco").Columns(i).ColumnWidth
        Next
      End With
  End If
  With Sheets("Voorblad").Range(Target.Address)
        If InStr(Target, " ") > 0 Or InStr(Target, ",") > 0 Then
            .Offset(0, 1) = "='" & Target & "'!$G$2"
            .Offset(0, 2) = "='" & Target & "'!$G$3"
        Else
            .Offset(0, 1) = "=" & Target & "!$G$2"
            .Offset(0, 2) = "=" & Target & "!$G$3"
        End If
  End With
  SortSheets
TheEnd:
  Application.EnableEvents = True
End Sub

HSV · 3 jul 2011

Mijn vorige code maakte gewoon tabbladen aan Bas.

@Rudi,

Dit moet toch al voldoende zijn?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False
   If Target.Column = 1 And Target <> "" Then
     Sheets.Add(after:=Sheets(Sheets.Count)).Name = Target
      Sheets("blanco").Range("1:5").Copy ActiveSheet.Range("1:5")
     ActiveSheet.Range("B2") = ActiveSheet.Name
    End If
 For i = 1 To 7
   ActiveSheet.Columns(i).ColumnWidth = Sheets("blanco").Columns(i).ColumnWidth
 Next
    Sheets("Voorblad").Range(Target.Address).Offset(0, 1) = "=[COLOR="red"]'[/COLOR]" & Target & "[COLOR="red"]'[/COLOR]!$G$2"
    Sheets("Voorblad").Range(Target.Address).Offset(0, 2) = "=[COLOR="red"]'[/COLOR]" & Target & "[COLOR="red"]'[/COLOR]!$G$3"
   Application.EnableEvents = True
 SortSheets
End Sub

bascas · 3 jul 2011

Heren, hartelijk bedankt!
Groeten Bas

VBA werkt niet

Gebruiker

Inventaris

Gebruiker

Gebruiker

Terugkerende gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Meubilair

Gebruiker

Meubilair

Gebruiker

Inventaris

Gebruiker

Meubilair

Inventaris

Gebruiker

Wij waarderen jouw privacy