Wir wünschen allen Forenteilnehmern ein frohes Fest und einen guten Rutsch ins neue Jahr. x

Tabelle Sortieren
#1
Hallo zusammen,
ich habe in einer anderen Excel Datei eine Tabelle von B12:J100

in der Zelle E12:E100 stehen datums angaben, hier möchte ich sortieren dafür habe ich folgenden Code genutzt:

Code:
With Workbooks("offene_Schulungen.xlsx").Sheets("Pflichtschulungen")
    .Range("B12:J100").Sort Key1:=.Range("E12"), Header:=xlYes

End With


Wenn ich nur diesen Code benutze funktioniert er wie gewünscht wenn ich diesen Code aber zu dem rest hinzufüge nicht mehr.

Code:
Private Sub OK_Button_Click()
Application.ScreenUpdating = False
Schulungen.test123 = Range("a1")

If IsWorkbookOpen("offene_Schulungen.xlsx") Then
GoTo weiter

Else
Workbooks.Open Filename:= _
        "R:\DKBS\CCC\Hotline1_Steuerung\INTERN\01. Tagessteuerung\aktive Schulungen\offene_Schulungen.xlsx"
End If

weiter:

Dim last As Integer
last = Workbooks("offene_Schulungen.xlsx").Sheets("Pflichtschulungen").Cells(Rows.Count, 5).End(xlUp).Row + 1
Workbooks("offene_Schulungen.xlsx").Sheets("Pflichtschulungen").Cells(last, 2).Value = Schulungen.Nachname.Value
Workbooks("offene_Schulungen.xlsx").Sheets("Pflichtschulungen").Cells(last, 3).Value = Schulungen.Vorname.Value
Workbooks("offene_Schulungen.xlsx").Sheets("Pflichtschulungen").Cells(last, 4).Value = Schulungen.Pflichtschulungen.Value
Workbooks("offene_Schulungen.xlsx").Sheets("Pflichtschulungen").Cells(last, 9).Value = Application.UserName

If Schulungen.Fällig.Value <> "" Then
Workbooks("offene_Schulungen.xlsx").Sheets("Pflichtschulungen").Cells(last, 5).Value = Schulungen.test123.Value
Else
Workbooks("offene_Schulungen.xlsx").Sheets("Pflichtschulungen").Cells(last, 5).Value = Schulungen.Datum_box.Value
End If


With Workbooks("offene_Schulungen.xlsx").Sheets("Pflichtschulungen")
    .Range("B12:J100").Sort Key1:=.Range("E12"), Header:=xlYes

End With


       


Workbooks("offene_Schulungen.xlsx").Worksheets("Pflichtschulungen").Range("B12:J100").Copy
        ThisWorkbook.Activate
        Worksheets("Pflichtschulungen").Range("B12:J100").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
       
       
       
       
       
Application.CutCopyMode = False
Workbooks("offene_Schulungen.xlsx").Close savechanges:=True
  Unload Schulungen
Application.ScreenUpdating = True
End Sub

Hat jemand eine Idee???

LG
Antworten Top
#2
Verwende With  ...  End With
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#3
ich habe doch with und end with genutzt, ich kann dir leider nicht folgen ^^
Antworten Top
#4
Hio,

versuche es mal so, ich habe den Code etwas bereinigt:
Code:
Private Sub OK_Button_Click()
   Application.ScreenUpdating = False
   Schulungen.test123 = Range("a1")
  
   If Not IsWorkbookOpen("offene_Schulungen.xlsx") Then
      Workbooks.Open Filename:= _
          "R:\DKBS\CCC\Hotline1_Steuerung\INTERN\01. Tagessteuerung\aktive Schulungen\offene_Schulungen.xlsx"
   Else
      Dim last As Integer
      
      With Workbooks("offene_Schulungen.xlsx").Sheets("Pflichtschulungen")
         last = .Cells(Rows.Count, 5).End(xlUp).Row + 1
         .Cells(last, 2).Value = Schulungen.Nachname.Value
         .Cells(last, 3).Value = Schulungen.Vorname.Value
         .Cells(last, 4).Value = Schulungen.Pflichtschulungen.Value
         .Cells(last, 9).Value = Application.UserName
        
         If Schulungen.Fällig.Value <> "" Then
            .Cells(last, 5).Value = Schulungen.test123.Value
         Else
            .Cells(last, 5).Value = Schulungen.Datum_box.Value
         End If
        
         .Range("B12:J100").Sort Key1:=.Range("E12"), Header:=xlYes
        
         .Range("B12:J100").Copy
         '  ThisWorkbook.Activate
         .Range("B12:J100").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
      End With
      
      Application.CutCopyMode = False
      Workbooks("offene_Schulungen.xlsx").Close savechanges:=True
      Unload Schulungen
      Application.ScreenUpdating = True
      
   End If
  
End Sub
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste