Thema Datum  Von Nutzer Rating
Antwort
22.11.2022 23:25:58 Sven
NotSolved
23.11.2022 19:49:24 ralf_b
NotSolved
23.11.2022 20:00:16 xlKing
NotSolved
23.11.2022 22:23:46 Sven
NotSolved
Rot Inhalt einer Tabelle individuell speichern
29.11.2022 21:05:56 xlKing
NotSolved

Ansicht des Beitrags:
Von:
xlKing
Datum:
29.11.2022 21:05:56
Views:
378
Rating: Antwort:
  Ja
Thema:
Inhalt einer Tabelle individuell speichern

Hallo Sven,

hier scheints irgendwie noch nicht weitergegangen zu sein. Wie ich bereits schrieb, benötigtst du dafür ein Workbook, wo du alle Daten sammelst. Angenommen das Wb heißt "Lieferantenbewertung.xlsm" und hat zwei Tabellenblätter "Einzeldaten" und "Gesamtdaten". Sobald du nun auf dem Blatt "Einzeldaten" eine Firma auswählst, die es auf dem Blatt "Gesamtdaten" noch nicht gibt, wird diese dort zusammen mit den einzelnen Bewertungskategorien angelegt. Ist sie jedoch bereits vorhanden müssen die erste und letzte Zeile der Firma ermittelt und die Daten aus den benachbarten Zellen geholt werden.

Grundsätzlich ist es immer besser, bei Fragen ein Beispielworkbook anstelle von Bildern hochzuladen. Kein Helfer hat wirklich Lust und Zeit, erst irgendwelche Beispieldaten nachzubauen. Ich habs trotzdem mal gemacht. War ja diesmal nicht viel. Leider zeigen deine Screenshots aber keinerlei Zeilen und Spaltenköpfe. Ich kann daher nur mutmaßen. Angenommen die Firma wird in B3 eingegeben und die Eingabezellen der Bewertungstabelle erstrecken sich von E8:K19 dann könnte der Code im Tabellenmodul "Einzeldaten" in etwa so lauten:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim First As Range, Last As Range, Gesamt As Worksheet
  
  Set Gesamt = Sheets("Gesamtdaten")
  Set First = Gesamt.Columns(1).Find(Range("B3").Value, SearchDirection:=xlNext)
  Set Last = Gesamt.Columns(1).Find(Range("B3").Value, SearchDirection:=xlPrevious)
  
  If Target.Address(False, False) = "B3" Then 'Wenn Firma wechselt
    If First Is Nothing Then
      Range("E8:K19").ClearContents
      Set First = Gesamt.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
      Set Last = First.Offset(19 - 8, 0)
      Gesamt.Range(First, Last).Value = Target.Value
      Gesamt.Range(First, Last).Offset(0, 1).Resize(, 2).Value = Range("C8:D19").Value
    Else
      Range("E8:K19").Value = Gesamt.Range(First, Last).Offset(0, 3).Resize(, 7).Value
    End If
  ElseIf Not Intersect(Target, Range("E8:K19")) Is Nothing Then
    If Not First Is Nothing And Not Last Is Nothing Then
      Gesamt.Range(First, Last).Offset(0, 3).Resize(, 7).Value = Range("E8:K19").Value
    End If
  End If
End Sub

Für das exportierte Speichern der Bewertung einer einzelnen Firma brauchst du dann nur noch einen Button, dem du den folgenden Code (z.B. im gleichen oder in einem allgemeinen Modul) hinterlegst:

Sub Firma_Extrahieren()
  Dim Pfad As String, Dateiname As String
  Pfad = ThisWorkbook.Path
  Dateiname = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & " (" & Range("B3").Value & ")"
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets("Einzeldaten").Copy
  ActiveWorkbook.SaveAs Pfad & "\" & Dateiname, FileFormat:=xlOpenXMLWorkbook
  ActiveWorkbook.Close
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Die Gesamt-Datei muss zuvor mindestens einmal gespeichert sein.

Möchtest du die Bewertung einer Firma nicht nur speichern, sondern auch gleich an eine Email anhängen und rausschicken? Dazu gibt es mehr als genügend Beispiele im Netz und auch hier im Forum. Deshalb gehe ich darauf nicht näher ein.

Gruß Mr. K.


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
22.11.2022 23:25:58 Sven
NotSolved
23.11.2022 19:49:24 ralf_b
NotSolved
23.11.2022 20:00:16 xlKing
NotSolved
23.11.2022 22:23:46 Sven
NotSolved
Rot Inhalt einer Tabelle individuell speichern
29.11.2022 21:05:56 xlKing
NotSolved