Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

VBA /Tabellenblatt anlegen und kopieren

Betrifft: VBA /Tabellenblatt anlegen und kopieren von: Klaus
Geschrieben am: 03.09.2020 11:50:11

Hallo,


ich bekomme aus einem Zeiterfassungssystem ein Text-File, dass ich in Excel einlese. Die Formatierung ist zwar schlecht, aber ich habe die Werte, die ich summieren will schön in einer Spalte.

Nun zu meinem Problem:

Das File beinhaltet ca. 50 Mitarbeiter, je Mitarbeiter kann die Länge (also die Anzahl der Zeilen) variieren. Ich hätte gerne pro Mitarbeiter ein Tabellenblatt, da die Summierung dann einfacher ist. Jeder neue Abschnitt beginnt in Spalte "B" mit einem bestimmten Text ("Zeitnachweisliste").


Kann man über VBA (und da kenne ich mich leider gar nicht aus) ein neues Tabellenblatt anlegen und den Inhalt hineinkopieren?


Ich hoffe es est soweit verständlich, in den Anhang habe ich eine Musterdatei gegeben (mit 2 Muster-Mitarbeiter; 1 MA ab Zeile 1, 2 MA ab Zeile 101).

https://www.herber.de/bbs/user/140014.xlsx

Danke!

Betrifft: AW: VBA /Tabellenblatt anlegen und kopieren
von: Herbert_Grom
Geschrieben am: 04.09.2020 17:55:42

Hallo Klaus,

zuerst einmal hast du da nicht nur 2 sondern 4 Mitarbeiter drin (Baek Lisa & Basek Mihael). Dann, was, bzw. welche Spalte willst du darin summieren?

Servus

Betrifft: AW: VBA /Tabellenblatt anlegen und kopieren
von: fcs
Geschrieben am: 04.09.2020 22:35:10

Hallo Klaus,

hier ein Makro zur Teilung der Liste.

für eine einfachere weitere Bearbeitung werden noch Leerstring in Zellen und führende/nachgestellte Leerzeichen in den Texten entfernt und Zahltexte in Zahlen umgewandelt.

LG
Franz
Sub Zeitliste_Teilen()
  Dim wkb As Workbook, wksListe As Worksheet, wksVorlage As Worksheet
  Dim Zeile As Long, Zeile_1 As Long, Zeile_2 As Long
  Dim wksName As Worksheet, varName
  Dim rngZelle As Range
  Dim varSuchen, s1stAddress As String
  Dim Spa_L As Long, Zei_L As Long
  
  Application.ScreenUpdating = False
  
  Set wkb = ActiveWorkbook
  Set wksListe = ActiveSheet
  Range("A1").Select
  Application.StatusBar = "Liste wird vorbereitet"
  With wksListe
    'letzte Zeile und Spalte ermitteln
    With .UsedRange
      Zei_L = .Row + .Rows.Count - 1
      Spa_L = .Column + .Columns.Count - 1
    End With
    'Leerstrings und führende/nachfolgende Leerzeichen löschen
    For Each rngZelle In .Range(.Cells(1, 1), .Cells(Zei_L, Spa_L)).Cells
      rngZelle.Value = Trim(rngZelle.Text)
      If rngZelle.Text = "" Then rngZelle.ClearContents
    Next
    'Zahlenformat setzen in palten mit Zahlenwerten
    .Range(.Columns(5), Columns(15)).NumberFormat = "0.00;-0.00;0.00"
    'Zahlentext in Zahlen umwandeln
    For Each rngZelle In .Range(.Cells(1, 5), .Cells(Zei_L, 15)).Cells
      If IsNumeric(rngZelle.Text) Then rngZelle = CDbl(rngZelle.Text)
    Next
    'Spaltenbreiten formatieren
    .Columns(1).ColumnWidth = 5
    .Columns(2).ColumnWidth = 28
    .Columns(3).ColumnWidth = 16
    .Range(.Columns(4), .Columns(8)).ColumnWidth = 7.5
    .Range(.Columns(9), .Columns(15)).ColumnWidth = 8
  End With
  'Vorlage anlegen
  Application.StatusBar = "Vorlage wird angelegt"
  wksListe.Copy before:=wksListe
  Set wksVorlage = ActiveSheet
  With wksVorlage
    .UsedRange.EntireRow.Delete
    .Name = "Vorlage"
  End With
  
  Zeile_1 = 1
  With wksListe
    varSuchen = "Zeitnachweisliste"
    Set rngZelle = .Range("B:B").Find(After:=.Cells(.Rows.Count, 2), What:=varSuchen, _
        LookIn:=xlValues, lookat:=xlWhole)
    If rngZelle Is Nothing Then
      MsgBox "Suchbegriff """ & varSuchen & """ nicht gefunden"
      GoTo Beenden
    End If
    s1stAddress = rngZelle.Address
    Zeile_1 = rngZelle.Row
    Do
      Set rngZelle = .Range("B:B").FindNext(After:=rngZelle)
      If rngZelle.Address = s1stAddress Then
        Zeile_2 = Zei_L
      Else
        Zeile_2 = rngZelle.Row - 1
      End If
      varName = .Cells(Zeile_1 + 3, 2).Text
      varName = Left(Mid(varName, Len("Mitarbeiter   : ")), 31)
      
      Application.StatusBar = "Blatt für MA " & varName & " wird angelegt"
      wksVorlage.Copy After:=wkb.Sheets(wkb.Sheets.Count)
      
      .Range(.Rows(Zeile_1), .Rows(Zeile_2)).Copy wkb.Sheets(wkb.Sheets.Count).Range("A1")
      wkb.Sheets(wkb.Sheets.Count).Name = varName
      
      If Zeile_2 = Zei_L Then Exit Do
      Zeile_1 = rngZelle.Row
    Loop
  End With
  
Beenden:
  Application.DisplayAlerts = False
  wksVorlage.Delete
  Application.DisplayAlerts = True
  
  Application.ScreenUpdating = False
      
  Application.StatusBar = False
  MsgBox "Fertig", vbOKOnly, "Liste teilen"
End Sub


Betrifft: AW: VBA /Tabellenblatt anlegen und kopieren
von: Klaus
Geschrieben am: 06.09.2020 20:13:26

Cool, danke das hat toll funktioniert!
Danke für deine Hilfe!
LG
Klaus

Beiträge aus dem Excel-Forum zum Thema "VBA /Tabellenblatt anlegen und kopieren"