Live-Forum - Die aktuellen Beiträge
Datum
Titel
13.10.2025 19:31:31
VBA Formel mit Bezug auf Überschrift anstatt Spalte
13.10.2025 15:10:17
Überlappende Zeiträume über mehrere Tabellen mit leeren Zell
13.10.2025 13:34:56
PQ Abfrage mit verschiedenen Werten ausführen + Protokoll
13.10.2025 12:24:02
Zählen in Abhängigkeit einer Jahreszahl
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
788to792
788to792
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

werte automatisch in andere tabelle abschpeichern

Forumthread: werte automatisch in andere tabelle abschpeichern

werte automatisch in andere tabelle abschpeichern
08.08.2006 20:18:14
WilliamM
Guten abend
wenn eine meßreihe von x-werten erreicht wird,sollen die werte in andere tabelle exportiert werden(wenn möglich jede reihe in neue zeile)
gibt es da ne (einfache) lösung
danke
https://www.herber.de/bbs/user/35662.xls
Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: werte automatisch in andere tabelle abschpeich
08.08.2006 23:56:11
Josef
Hallo William!
Kopiere diesn Code in das Modul der Tabelle.
Beim ersten Export, wird die Datei "Backup.xls" im Verzeichnis der Mappe erstellt.
Die weiteren Daten werden untereinander angefügt.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Enum XL_FILESTATUS
  XL_UNDEFINED = -1
  XL_CLOSED
  XL_OPEN
  XL_DONTEXIST
End Enum

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("B2:L2")) Is Nothing Then
  If Application.CountA(Range("B2:L2")) >= 11 Then
    If exportData(Range("B2:L2")) <> 0 Then
      If MsgBox("Die Daten wurden erfolgreich exportiert!" & Space(20) & _
        vbLf & vbLf & "Sollen die Daten gelöscht werden?", 292, "EXPORT") = 6 Then
        Range("B2:L2").ClearContents
      End If
    Else
      MsgBox "Fehler beim Export der Daten!" & Space(15), 64, "FEHLER"
    End If
  End If
End If

End Sub



Private Function exportData(ByRef rng As Range) As Long
Dim xlApp As Application
Dim objWb As Workbook
Dim objSh As Worksheet
Dim lngNext As Long
Dim strFile As String
Dim myStatus As XL_FILESTATUS

On Error GoTo ErrExit
GetMoreSpeed

strFile = ThisWorkbook.Path & "\Backup.xls"

If Dir(strFile) = "" Then
  
  Me.Copy
  With ActiveWorkbook
    .SaveAs strFile
    .VBProject.VBComponents(.Sheets(1).CodeName).CodeModule.DeleteLines 1, _
      .VBProject.VBComponents(.Sheets(1).CodeName).CodeModule.CountOfLines
    .Close True
  End With
  
  exportData = -1
  
  GoTo ErrExit
End If

myStatus = FileStatus(strFile)

If myStatus = XL_OPEN Then
  strFile = Dir(strFile)
  Set objWb = Workbooks(strFile)
  Set objSh = objWb.Sheets(1)
  lngNext = objSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
  objSh.Cells(lngNext, 1) = Me.Range("A2")
  objSh.Range(objSh.Cells(lngNext, 2), objSh.Cells(lngNext, 12)).Value = rng.Value
  objWb.Save
  
  exportData = -1
  
ElseIf myStatus = XL_CLOSED Then
  
  Set xlApp = CreateObject("Excel.Application")
  
  With xlApp
    Set objWb = .Workbooks.Open(strFile)
    Set objSh = objWb.Sheets(1)
    lngNext = objSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
    objSh.Cells(lngNext, 1) = Me.Range("A2")
    objSh.Range(objSh.Cells(lngNext, 2), objSh.Cells(lngNext, 12)).Value = rng.Value
    objWb.Close True
    .Quit
  End With
  
  exportData = -1
  
End If

ErrExit:
GetMoreSpeed 0
Set objSh = Nothing
Set objWb = Nothing
Set xlApp = Nothing

End Function


Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
Static lngCalc As Long

With Application
  If Modus = 1 Then
    lngCalc = .Calculation
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Calculation = -4135
    .Cursor = xlWait
  Else
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .Calculation = IIf(lngCalc > 0, lngCalc, -4105)
    .Cursor = xlDefault
  End If
End With

End Sub


Private Function FileStatus(xlFile As String) As XL_FILESTATUS

On Error Resume Next

Dim File%: File = FreeFile

Err.Clear

Open xlFile For Binary Access Read Lock Read As #File
Close #File

Select Case Err.Number
  Case 0: FileStatus = XL_CLOSED
  Case 70: FileStatus = XL_OPEN
  Case 76: FileStatus = XL_DONTEXIST
  Case Else: FileStatus = XL_UNDEFINED
End Select

End Function


Gruß Sepp

Anzeige
AW: werte automatisch in andere tabelle abschpeich
09.08.2006 17:11:47
WilliamM
Danke....werde es machen..und berichten
AW: werte automatisch in andere tabelle abschpeich
09.08.2006 19:19:09
WilliamM
Danke Sepp ...es klappt wunderbar
Noch eine frage/bitte.... wie sieht es aus mit Befehlsschaltfläche...wie "Exportieren/Speichern" also eine "Halbautomatik"
So kann ich mir die Werte in ruhe ansehen und dann "Exportieren/Speichern"
Gruß
William
Anzeige
AW: werte automatisch in andere tabelle abschpeich
09.08.2006 20:10:17
WilliamM
Hab vergessen...."Frage noch offen" zu aktivieren
AW: werte automatisch in andere tabelle abschpeich
09.08.2006 20:21:19
Josef
Hallo William!
Füge in dein Tabellenblatt einen CommandButton aus der Steuerelemente-Toolbox ein.
Ersetze dann den Code im Tabellenmodul durch den folgenden.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Enum XL_FILESTATUS
  XL_UNDEFINED = -1
  XL_CLOSED
  XL_OPEN
  XL_DONTEXIST
End Enum

Private Sub CommandButton1_Click()
Dim intC As Integer

If MsgBox("Wollen Sie die Daten exportieren?" & Space(15), 36, "EXPORT") = 6 Then
  intC = Application.CountA(Range("B2:L2"))
  If intC = 0 Then
    MsgBox "Es sind keine Daten vorhanden!" & Space(15), 32, "ABBRUCH"
    Exit Sub
  ElseIf intC < 11 Then
    If MsgBox("Es sind nicht alle Datenfelder gefüllt!" & Space(15) & vbLf & vbLf & _
      "Export fortsetzen?", 36, "EXPORT") <> 6 Then Exit Sub
  End If
  
  If exportData(Range("B2:L2")) <> 0 Then
    If MsgBox("Die Daten wurden erfolgreich exportiert!" & Space(20) & _
      vbLf & vbLf & "Sollen die Daten gelöscht werden?", 292, "EXPORT") = 6 Then
      Range("B2:L2").ClearContents
    End If
  Else
    MsgBox "Fehler beim Export der Daten!" & Space(15), 64, "FEHLER"
  End If
  
End If

End Sub


Private Function exportData(ByRef rng As Range) As Long
Dim xlApp As Application
Dim objWb As Workbook
Dim objSh As Worksheet
Dim lngNext As Long
Dim strFile As String
Dim myStatus As XL_FILESTATUS

On Error GoTo ErrExit
GetMoreSpeed

strFile = ThisWorkbook.Path & "\Backup.xls"

If Dir(strFile) = "" Then
  
  Me.Copy
  With ActiveWorkbook
    .SaveAs strFile
    .Sheets(1).Shapes(1).Delete
    .VBProject.VBComponents(.Sheets(1).CodeName).CodeModule.DeleteLines 1, _
      .VBProject.VBComponents(.Sheets(1).CodeName).CodeModule.CountOfLines
    .Close True
  End With
  
  exportData = -1
  
  GoTo ErrExit
End If

myStatus = FileStatus(strFile)

If myStatus = XL_OPEN Then
  strFile = Dir(strFile)
  Set objWb = Workbooks(strFile)
  Set objSh = objWb.Sheets(1)
  lngNext = objSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
  objSh.Cells(lngNext, 1) = Me.Range("A2")
  objSh.Range(objSh.Cells(lngNext, 2), objSh.Cells(lngNext, 12)).Value = rng.Value
  objWb.Save
  
  exportData = -1
  
ElseIf myStatus = XL_CLOSED Then
  
  Set xlApp = CreateObject("Excel.Application")
  
  With xlApp
    Set objWb = .Workbooks.Open(strFile)
    Set objSh = objWb.Sheets(1)
    lngNext = objSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
    objSh.Cells(lngNext, 1) = Me.Range("A2")
    objSh.Range(objSh.Cells(lngNext, 2), objSh.Cells(lngNext, 12)).Value = rng.Value
    objWb.Close True
    .Quit
  End With
  
  exportData = -1
  
End If

ErrExit:
GetMoreSpeed 0
Set objSh = Nothing
Set objWb = Nothing
Set xlApp = Nothing

End Function


Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
Static lngCalc As Long

With Application
  If Modus = 1 Then
    lngCalc = .Calculation
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Calculation = -4135
    .Cursor = xlWait
  Else
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .Calculation = IIf(lngCalc > 0, lngCalc, -4105)
    .Cursor = xlDefault
  End If
End With

End Sub


Private Function FileStatus(xlFile As String) As XL_FILESTATUS

On Error Resume Next

Dim File%: File = FreeFile

Err.Clear

Open xlFile For Binary Access Read Lock Read As #File
Close #File

Select Case Err.Number
  Case 0: FileStatus = XL_CLOSED
  Case 70: FileStatus = XL_OPEN
  Case 76: FileStatus = XL_DONTEXIST
  Case Else: FileStatus = XL_UNDEFINED
End Select

End Function


Gruß Sepp

Anzeige
AW: werte automatisch in andere tabelle abschpeich
09.08.2006 21:42:17
WilliamM
Danke......Funzt alles SUPER
Gruß
;

Forumthreads zu verwandten Themen

Beim Kopieren eines Tabellenblattes den VBA-Code e
Alfi

Hallo Excel-Gemeinde!
ich habe eine mehrblättrige Datei, per Makro kopiere ich ein Blatt und speichere dieses unter neuem Namen ab.
Dieses Blatt soll aber nicht mehr den VBA-Code der ursprübglichen Datei enthalten, sprich ein Blatt ohne Makros.
Wer kann mir helfen?
So sieht der...
09.09.2008 09:58:00
Thread-ID: 1008333
8 Beiträge
Anzeige
Text aus einer Zelle in ein anderes Tabellenblatt
grigolet

Hallo,
ich erstelle gerade eine Arbeitsmappe in der auf verschiedenen Tabellenblättern die gleichen Namen erscheinen sollen (aus dem Blatt 'Verhandlungsergebnis' sollen die Personendaten der Beteiligten in ein erstelltes Vertragsformular übernommen werden). Ich habe das z.B. mit = gelöst. J...
09.10.2008 11:24:26
Thread-ID: 1015295
2 Beiträge
Texte aus anderem Tabellenblatt kopieren
Stefan

Hallo zusammen,
in einer Tabelle habe ich mir im Tabellenblatt 'Umwandeln' für verschiedene Textmanipulationen Formeln eingerichtet. Die Texte, die verändert werden sollen (Artikelbezeichungen) bekomme ich in Form einer Exceltabelle und ich ziehe mir das Tabellenblatt 'Artikel' als neues Ta...
22.04.2009 23:35:00
Thread-ID: 1070529
3 Beiträge
Formel komplett aus anderem Blatt übernehmen
martin

Hallo.
In verschiedenen Arbeitsbättern befinden sich exakt die selben Rechnungen, jeweils mit unterschiedlichen Werten.
In einem Master-Blatt möchte ich gerne die Zeilen und Spaltenbeschriftungen, sowie die zu verwenden formeln definieren.
Könnt Ihr mir Tipps geben, wo ich dazu was...
18.06.2009 14:56:18
Thread-ID: 1082618
2 Beiträge
Zellen in neuem Tabellenblatt kopieren
Ingo

Hallo zusammen,
folgendes Problem:
In meiner ersten Spalte sind x Zellen, wobei eine Zelle mehrere Wörter (durch Semikolon getrennt) enthalten können (siehe Überschrift Ausgangssituation).
Diese müssen in einem neuen Tabellenblatt nun untereinander kopiert werden (siehe Überschrift...
10.11.2009 13:16:06
Thread-ID: 1115551
3 Beiträge
Anzeige
Zeile in anderes Tabellenblatt kopieren
Carle

Hallo zusammen!
Ich würde gerne in einem Arbeitsblatt die Kopfzeile einer Tabelle in ein anderes Tabellenblatt derselben Arbeitsmappe kopieren, und zwar in der Weise, dass bei einer Änderung der Tabellenzeile (z. B. durch Einfügen einer neuen Spalte oder Änderung des Werts einer Zelle) sich...
01.02.2010 20:51:08
Thread-ID: 1134230
3 Beiträge
werte in anderes tabellenblatt mit ; kopieren
Helmut

hallo liebe vba’ler,
noch eine letzte frage für heute:
ich habe ein excel-sheet. In diesem habe ich 5 spalten, in denen sich daten (Zahlen, Worte) befinden. Wie kann ich über ein vba-script diese daten in ein anderes tabellenblatt des sheets kopieren, und zwar so, dass die kopierten dat...
08.03.2010 17:51:04
Thread-ID: 1144386
7 Beiträge
Daten in anderes Tabellenblatt kopieren
Werner

Hallo zusammen,
ich möchte Daten von Activen Tabellenblatt in die Tabelle1 kopieren. Ich habe es mit nen Makrorekorter propiert aber ohne Erfolg.
Es sollen im Act. Tabellenblatt die Bereiche:
A1:A30 in die Tabelle1 in die gleichen Zellen (A1:A30) kopiert werden.
C1:A30 in die Ta...
15.09.2010 20:26:28
Thread-ID: 1177919
10 Beiträge
Zellen B7:K16 in anderes Blatt kopieren
Wolfgang

Hallo,
ich würde gerne erreichen, dass auf Schaltflächendruck aus dem Tabellenblatt "Start" der Bereich B7:K16 in das Tabellenblatt "Archiv" kopiert wird, allerdings immer nach oben -ab B2- als erstes. Vorheriger Text soll nach unten verschoben werden. Habe das mit dem Makrorekorder versuch...
13.02.2011 11:12:08
Thread-ID: 1200486
14 Beiträge
Zellen in anderes Arbeitsblatt kopieren
Stefan

Hallo,
Ich habe eine Quell- und eine Zieldatei in jeweils verschiedenen Arbeitsmappen. Beide Dateien haben die gleiche Struktur.
dazu habe ich folgenden Code, der mir hier zur Verfügung gestellt wurde:
Private Sub CommandButton1_Click() Dim wksQuelle As Worksheet Dim rngRow As Range...
03.03.2011 20:04:40
Thread-ID: 1203864
3 Beiträge
Anzeige
Daten in anderes Tabellenblatt kopieren
Stefan

Hallo,
ich habe mal wieder ein Problem:
folgender Code wurde mir hier zur Verfügung gestellt und funktioniert auch:
Private Sub CommandButton1_Click() Dim lRow As Long Dim sRow As Long Dim myWks As String Dim wkbZiel As Workbook, wksZiel As Worksheet Dim wksQuelle As Worksheet Set w...
01.04.2011 11:39:42
Thread-ID: 1208393
9 Beiträge
Anzeige
Daten aus tabelle in andere übertragen makro
Jens

Hallo Leute,
nachdem ich mich jetzt seit tagen mit Macros rumärgere dachte ich, ich wende mich mal an die Profis.
Also ich habe folgendes Problem:
Ich habe dein Tabellenblatt das eigentlich als eingabeblatt fungiert. Ich bräuchte ein Makro dass z.B.
Die Zelle B10 von Tabellenbl...
02.08.2011 14:02:25
Thread-ID: 1224570
10 Beiträge
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige