Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1632to1636
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Kopie an vorhandene Datei anhängen

Kopie an vorhandene Datei anhängen
07.07.2018 17:15:38
pops.Brownski
Hallo zusammen,
in meiner angehängten Datei habe ich einen Commandbutton der die vorhandenen Daten löscht und vorher noch kopiert.
Sinn der Tabelle ist es die Werte über einen Monat zu sammeln und abschließend die Werte zu kopieren, in eine neu erstellte Datei übertragen, speichern und die eigentliche Tabelle zu bereinigen.
Jetzt soll die Datei, in die die Werte kopiert werden, Werte vom ganzen Jahr enthalten/aufnehmen. Sprich das kopieren der Daten/Werte müsste immer unten angehangen werden und wenn das Jahr 2018 abgeschlossen ist müsste eine neue Tabelle erstellt werden.
Zu dem dürfte nur einmalig beim erstellen der Kopie die ersten 3 Zeilen mitgenommen werden, sonst nur die eingegebenen Werte.
Habt Ihr evtl eine Ergänzungsmöglichkeit für meine Codes?
https://www.herber.de/bbs/user/122527.xlsm
Ich danke euch jetzt schon einmal und wünsche ein schönes Wochenende
Gruß Markus

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopie an vorhandene Datei anhängen
07.07.2018 18:20:52
Sepp
Hallo Markus,
Private Sub Commandbutton1_Click()
  Dim strFile As String, objWB As Workbook, lngNext As Long
  
  If TextBox1.Text = "dpihs" Then
    strFile = ThisWorkbook.Path & "\TEST_Statistik_TEST" & Format(Now, "YYYY") & ".xlsx"
    Application.ScreenUpdating = False
    If Dir(strFile, vbNormal) = "" Then
      ThisWorkbook.Worksheets("Poststelle").Copy
      With ActiveWorkbook
        .Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value
        .SaveAs strFile, 51
        .Close True
      End With
    Else
      Set objWB = Workbooks.Open(strFile)
      With objWB.Sheets(1)
        lngNext = Application.Max(4, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
        ThisWorkbook.Sheets("Poststelle").Range("A4:FB110").Copy
        .Cells(lngNext, 1).PasteSpecial xlPasteValues
        Application.Goto .Range("A4"), True
      End With
      Application.CutCopyMode = False
      objWB.Close True
    End If
    'Poststelle 
    ThisWorkbook.Sheets("Poststelle").Range("A4:FB110").ClearContents
    Application.ScreenUpdating = True
    MsgBox "Der Tabelleninhalt wurde kopiert und abgespeichert!" & vbLf & ThisWorkbook.Path & vbLf & "Die aktuelle Tabelle wurde komplett bereinigt."
    Unload Me
  Else
    MsgBox "Sie sind nicht autorisiert"
    TextBox1.Text = ""
    TextBox1.SetFocus
  End If
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Falls nicht vorhanden, wird eine Datei für das Jahr angelegt, sonst werden die Daten kopiert.
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Kopie an vorhandene Datei anhängen
07.07.2018 18:52:16
pops.Brownski
Hallo Sepp,
erst einmal besten Dank, dass funktioniert genau so, wie ich es wollte.
Allerdings habe ich jetzt gemerkt, dass sich das an der Systemzeit zu orientieren scheint.
Ist es möglich, dem Code zu sagen, er soll sich an dem Datum im Tabellenblatt orientieren?
Ich gehe davon aus, dass die Tabelle immer zwischen dem 01. und 03. eines neuen Monats bereinigt wird, sprich am 03.01.2019 bekomme ich dann nicht die Werte in die Tabelle ...2018.
Allerdings merke ich gerade, dass dann auch die neuen Werte verloren gehen.
Hast du hier evtl ebenfalls eine Lösung?
Vielen Dank noch einmal für die kompetente Hilfe.
Ein tolles Forum!!!
Gruß Markus
Anzeige
AW: Kopie an vorhandene Datei anhängen
07.07.2018 19:03:45
Sepp
Hallo Markus,
kann man sich am Datum in Spalte A orientieren, oder muss man alle Datumsspalten prüfen?
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Kopie an vorhandene Datei anhängen
07.07.2018 19:09:30
pops.Brownski
Hallo Sepp,
ganz Lieb wäre mir die Variante mir den mehreren Spalten aber wenn dies zu Aufwendig ist, reicht für meine Zwecke auch vollkommen nur mit Spalte A.
Ist der veränderte Code auch mit 6 Tabellenblättern möglich?
Gruß Markus
AW: Kopie an vorhandene Datei anhängen
07.07.2018 21:41:42
Sepp
Hallo Markus,
hier mal der Code der nur das Datum in Spalte A berücksichtigt.
Private Sub Commandbutton1_Click()
  Dim strFile As String, objWB As Workbook, objSrc As Worksheet, lngNext As Long
  Dim lngMax As Long, lngMin As Long, lngYear As Long
  
  On Error Resume Next
  If TextBox1.Text = "dpihs" Then
    Set objSrc = ThisWorkbook.Sheets("Poststelle")
    With objSrc
      lngMin = Year(Application.Min(.Range("A:A")))
      lngMax = Year(Application.Max(.Range("A:A")))
    End With
    If lngMin > 0 And lngMax > 0 Then
      Application.ScreenUpdating = False
      For lngYear = lngMin To lngMax
        strFile = ThisWorkbook.Path & "\TEST_Statistik_TEST" & CStr(lngYear) & ".xlsx"
        If Dir(strFile, vbNormal) = "" Then
          ThisWorkbook.Worksheets("Poststelle").Copy
          With ActiveWorkbook
            .Sheets(1).AutoFilterMode = False
            .Sheets(1).Range("A4:FB110").ClearContents
            .SaveAs strFile, 51
            .Close True
          End With
        End If
        objSrc.Range("A3:FB110").AutoFilter Field:=1, Operator:= _
          xlFilterValues, Criteria2:=Array(0, "12/31/" & CStr(lngYear))
        Set objWB = Workbooks.Open(strFile)
        With objWB.Sheets(1)
          .AutoFilterMode = False
          lngNext = Application.Max(4, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
          objSrc.Range("A4:FB110").SpecialCells(xlCellTypeVisible).Copy
          .Cells(lngNext, 1).PasteSpecial xlPasteValues
          Application.Goto .Range("A4"), True
        End With
        Application.CutCopyMode = False
        objWB.Close True
      Next
      'Poststelle 
      objSrc.AutoFilterMode = False
      objSrc.Range("A4:FB110").ClearContents
      Application.ScreenUpdating = True
      MsgBox "Der Tabelleninhalt wurde kopiert und abgespeichert!" & vbLf & ThisWorkbook.Path & vbLf & _
        "Die aktuelle Tabelle wurde komplett bereinigt."
      Set objSrc = Nothing
    Else
      MsgBox "Keine daten vorhanden!"
    End If
    Unload Me
  Else
    MsgBox "Sie sind nicht autorisiert"
    TextBox1.Text = ""
    TextBox1.SetFocus
  End If
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


Was kommt noch? Erst das aktuelle Jahr, dann das Jahr aus den Daten und jetzt 6 Tabellen.
Du solltest schon zu Beginn alle Anforderungen beschreiben.
Wie sehen denn die anderen Tabellen aus? Wohin sollen die Daten?
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Kopie an vorhandene Datei anhängen
08.07.2018 21:26:27
pops.Brownski
Hallo Sepp,
es ist nicht meine Intention hier jmd. zu entnerven oder zu belästigen.
Das tut mir Leid.
Daher war meine Anfrage auch eher klein gehalten.
Zu mal die Datei bereits recht groß ist und viele Funktionen sich ja doch recht schnell umschreiben lassen.
Also die gesamte Idee hinter der Tabelle ist:
Mehrere Bereiche sollen über meine Tabelle die Möglichkeit haben Ihre Werte einzutragen, bisher macht das jeder Bereich für sich selbst.
Und mein Job ist es aus allen Tabellen entsprechende Werte zur Abrechnung zu suchen und zusammen zu fassen.
Leider können hier nur 300 kb hoch geladen werden, daher kann ich leider nicht mein Gesamtes zeigen. Sorry
Und natürlich mal wieder besten Dank für die Hilfreiche Unterstützung!
Gruß Markus
Anzeige
AW: Kopie an vorhandene Datei anhängen
08.07.2018 21:53:56
Sepp
Hallo Markus,
ich bin nicht entnervt!
Warum machst du nicht für jede Abteilung eine separate Datei und sammelst die Daten zur Abrechnung z.B. per PowerQuerry. Dort kannst du dann jeden gewünschten Zeitraum anzeigen und vieles mehr und die Auszüge auch exportieren.
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Kopie an vorhandene Datei anhängen
09.07.2018 08:02:12
Markus
Hallo Sepp,
da ich in Sachen Excel noch nicht ganz so Fit bin, wie ich es gerne wäre, fehlt mir einfach die Kenntnis über solche Add Ins.
Auch VBA ist für mich, bis vor 4 Wochen Neuland gewesen, daher bin ich über eure geballte Fachkompetenz sehr erfreut.
Ich habe eben mal gegoggelt und scheinbar ist Power Query erst aber der Office Version 2016 fest integriert und bei uns arbeiten viel Rechner noch mit 2003. Also wahrscheinlich ein Risiko.
Ich schicke dir mal eben meinen alten Code, wie er vor deiner Umschreibung genau aussah.
Allerdings sind da auch noch nicht alle Bereiche drin.

Private Sub Commandbutton1_Click()
Application.ScreenUpdating = False
Worksheets(Array("Poststelle", "Arbeitsvorbereitung", "Digitalisierung", "eMedien", " _
Infofax", "Validierung")).Copy 'Partner und IVK fehlt noch
With ActiveSheet.UsedRange
.Value = .Value
End With
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\TEST_Statistik_TEST" & Format(Now, "YYYY") & ".xlsx", 51
.Close False
End With
Application.ScreenUpdating = True
If TextBox1.Text = "dpihs" Then
Unload Me
'Poststelle
Sheets("Poststelle").Range("A4:FB110").ClearContents
'Partner
'Sheets("Partner").Range("I4:N110").ClearContents
'Arbeitsvorbereitung
Sheets("Arbeitsvorbereitung").Range("A4:Q110").ClearContents
'Digitalisierung
Sheets("Digitalisierung").Range("A4:U110").ClearContents
'eMedien
Sheets("eMedien").Range("A4:A110").ClearContents
Sheets("eMedien").Range("C4:AW110").ClearContents
Sheets("eMedien").Range("AY4:BC110").ClearContents
Sheets("eMedien").Range("BE4:CP110").ClearContents
'Infofax
Sheets("Infofax").Range("A4:J110").ClearContents
'Validierung
Sheets("Validierung").Range("A4:S110").ClearContents
'IVK Clearing
'Sheets("IVK Clearing").Range(A4:Z110").ClearContents
MsgBox "Der Tabelleninhalt wurde kopiert und abgespeichert!" & vbLf & ThisWorkbook.Path &  _
vbLf & "Die aktuelle Tabelle wurde komplett bereinigt."
Else
MsgBox "Sie sind nicht autorisiert"
TextBox1.Text = ""
TextBox1.SetFocus
End If
End Sub
Das ist das, was ich mir bis dato zusammen gebastelt hatte.
Gruß Markus
Anzeige
AW: Kopie an vorhandene Datei anhängen
09.07.2018 19:23:29
Sepp
Hallo Markus,
also PowerQuerry brauchst du nur auf deinem Rechner um die Daten auszuwerten.
Zu deinem Code: Das ist etwas zu wenig, um daraus abzuleiten, was von wo, warum und wohin archiviert werden soll. auch ist dein Tabellenaufbau für die Auswertung eher suboptimal.
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Kopie an vorhandene Datei anhängen
10.07.2018 08:59:31
Markus
Guten Morgen Sepp,
das Power Query werde ich mir definitiv ein anderes mal genauer anschauen.
Für den Tipp schon einmal vielen Dank.
Dein Code für das eine Tabellenblatt war schon quasi perfekt (für meine Leihen- Kenntnisse),
alle Tabellenblätter sollen eigentlich nur 1 zu 1 in eine neue Tabelle kopiert werden.
Alle Tabellenblätter sind gleich aufgebaut, also überall könnte man sich beim Datum an Spalte A orientieren (auch eMedien!, wird noch angepasst).
Der ClearContens ändert sich durch die Anpassung im Blatt eMedien auch nicht mehr.
Wie würdest du mir den einen Aufbau empfehlen?
Gruß Markus
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige