Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 10:39:36
Schaltfläche auf einem Tabellenblatt NICHT mit abspeichern
19.04.2024 09:26:26
Median für Zeilen mit gleichen Zeitstempel
19.04.2024 08:41:23
Zwei Makros in ein Arbeitsblatt - zweite wird nicht ausführt
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
984to988
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
984to988
984to988
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Dateneingabe ohne Userform

Dateneingabe ohne Userform
08.06.2008 18:06:00
Maiks
Hallo zusammen,
ich möchte Daten von bestimmten Zelle einer Excel-Datei mit klick einem Button in andere Excel-Datei eintragen ohne Userform.
Tagelang bin ich auf der Suche nach änhlichem VBA-Code. habe ich endlich etwas gefunden. Leider dieser Code trägt die Daten in dieselbe Excel-Datei und in dieselbe Excel-Tabelle.
ich brauche aber die Daten in andere Excel-Datei (mit Filename: Preisliste.xls) . diese File steht auf
C:\Artikelliste\Preisliste.xls
und dieser Code soll die Daten in der Tabelle1 ab Zeile A3 der excel-Datei Preisliste.xls eintragen.
mein Problem ist: ich weiss nicht wie meinem neuen Pfad in dem Code, der gefunden habe, schreiben soll.
hier ist der Code, die ich am Net gefunden habe:
https://www.herber.de/bbs/user/52931.xls
für jede Hilfe bin ich euch sehr dankbar
Maik

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateneingabe ohne Userform
08.06.2008 18:28:18
Daniel
Hi
so müsstest du den Code abändern, wenn die Daten in eine ander Datei übertragen werden sollen.
die Datei muss aber geöffnet sein, sonst gehts nicht.
'######################################################
'# #
'# Diese Makros stammen von Bert Körn #
'# E-Mail: berti@excelabc.de #
'# Homepage: http://www.excelabc.de #
'# #
'######################################################
Option Explicit

Sub Daten_eintragen()
Dim Zeile
'nur wenn in B3 und D3 etwas drinsteht dann eintragen
If [b3]  "" And [d3]  "" Then
'Blattschutz aufheben
With Workbooks("Preisliste.xls").Sheets("Tabelle1")
'letzte benutzte Zeile ermitteln + 1
Zeile = .Cells(Rows.Count, 1).SpecialCells(xlLastCell).Row + 1
'Daten eintragen
.Cells(Zeile, 1) = [b3]
.Cells(Zeile, 2) = [d3]
.Cells(Zeile, 3) = [b5]
.Cells(Zeile, 4) = [d5]
.Cells(Zeile, 5) = [b7]
.Cells(Zeile, 6) = [d7]
.Cells(Zeile, 7) = [b9]
.Cells(Zeile, 8) = [d9]
.Cells(Zeile, 9) = [b11]
.Cells(Zeile, 10) = [d11]
.Cells(Zeile, 11) = [b13]
.Cells(Zeile, 12) = [d13]
'Eingaben löschen
[b3:b13] = ""
[d3:d13] = ""
 end with
Else
MsgBox "Bitte Namen eintragen"
End If
'Blattschutz aktivieren
End Sub


Gruß, Daniel

Anzeige
AW: Dateneingabe ohne Userform
08.06.2008 18:29:12
Josef
Hallo Maik,
ändere das Makro mal um. (ungetestet!)
Sub Daten_eintragen()
Dim objWb As Workbook, objSh As Worksheet, objThisSheet As Worksheet
Dim strFile As String
Dim Zeile

On Error GoTo ErrExit

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

strFile = "C:\Artikelliste\Preisliste.xls" 'Datei in die geschrieben wird - Anpassen!

Set objThisSheet = ThisWorkbook.Sheets("Tabelle1") 'Tabellenblatt mit dem Formular - Anpassen!
Set objWb = Workbooks.Open(strFile)
Set objSh = objWb.Sheets("Tabelle1") 'Tabelle in die geschrieben wird - Anpassen!

Zeile = Application.Max(objSh.Cells(Rows.Count, 1).End(xlUp).Row + 1, 3)

'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
    If .[b3] <> "" And .[d3] <> "" Then
        
        'Daten eintragen
        objSh.Cells(Zeile, 1) = .[b3]
        objSh.Cells(Zeile, 2) = .[d3]
        objSh.Cells(Zeile, 3) = .[b5]
        objSh.Cells(Zeile, 4) = .[d5]
        objSh.Cells(Zeile, 5) = .[b7]
        objSh.Cells(Zeile, 6) = .[d7]
        objSh.Cells(Zeile, 7) = .[b9]
        objSh.Cells(Zeile, 8) = .[d9]
        objSh.Cells(Zeile, 9) = .[b11]
        objSh.Cells(Zeile, 10) = .[d11]
        objSh.Cells(Zeile, 11) = .[b13]
        objSh.Cells(Zeile, 12) = .[d13]
        'Eingaben löschen
        .[b3:b13] = ""
        .[d3:d13] = ""
        
    Else
        MsgBox "Bitte Namen eintragen"
    End If
End With

objWb.Close True

ErrExit:

If Err.Number > 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

Set objWb = Nothing
Set objSh = Nothing
Set objThisSheet = Nothing
End Sub


Gruß Sepp



Anzeige
AW: Dateneingabe ohne Userform
08.06.2008 18:59:56
Maiks
Hallo Daniel, Hallo Sepp,
vielen dank für euer schnelle Anworten
ich habe die beide Code getestet.
erst von Daniel: ich habe folgende Fehlermeldung:
Userbild
danach habe ich auch den Code von Sepp getestet: der Code trägt die Datei ein, leider habe ich ad auch zwei fehler
erst: die Zelle D3 bis D13 werden nicht leer.
zweite: die Fehlermeldung
Userbild
vielen dank im voraus.
Maiks

Anzeige
AW: Dateneingabe ohne Userform
08.06.2008 19:03:00
Josef
Hallo Maik,
die Fehlermeldung sagt doch schon woran es liegt, dein Blatt ist geschützt.
Nimm diesen Code.
Sub Daten_eintragen()
Dim objWb As Workbook, objSh As Worksheet, objThisSheet As Worksheet
Dim strFile As String
Dim Zeile

On Error GoTo ErrExit

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

strFile = "C:\Artikelliste\Preisliste.xls" 'Datei in die geschrieben wird - Anpassen!

Set objThisSheet = ThisWorkbook.Sheets("Tabelle1") 'Tabellenblatt mit dem Formular - Anpassen!
Set objWb = Workbooks.Open(strFile)
Set objSh = objWb.Sheets("Tabelle1") 'Tabelle in die geschrieben wird - Anpassen!

Zeile = Application.Max(objSh.Cells(Rows.Count, 1).End(xlUp).Row + 1, 3)

'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
    .Unprotect
    If .[b3] <> "" And .[d3] <> "" Then
        
        'Daten eintragen
        objSh.Cells(Zeile, 1) = .[b3]
        objSh.Cells(Zeile, 2) = .[d3]
        objSh.Cells(Zeile, 3) = .[b5]
        objSh.Cells(Zeile, 4) = .[d5]
        objSh.Cells(Zeile, 5) = .[b7]
        objSh.Cells(Zeile, 6) = .[d7]
        objSh.Cells(Zeile, 7) = .[b9]
        objSh.Cells(Zeile, 8) = .[d9]
        objSh.Cells(Zeile, 9) = .[b11]
        objSh.Cells(Zeile, 10) = .[d11]
        objSh.Cells(Zeile, 11) = .[b13]
        objSh.Cells(Zeile, 12) = .[d13]
        'Eingaben löschen
        .[b3:b13] = ""
        .[d3:d13] = ""
        .Protect
    Else
        MsgBox "Bitte Namen eintragen"
    End If
End With

objWb.Close True

ErrExit:

If Err.Number > 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

Set objWb = Nothing
Set objSh = Nothing
Set objThisSheet = Nothing
End Sub


Gruß Sepp



Anzeige
letzte Eintagung
08.06.2008 19:28:00
Maiks
Hallo Sepp,
ich habe noch eine Frage öffnet.
wäre es möglich, dass die letzte Eintragung immer oben bleibt bzw. immer in der Zeile 3?
danke für deine Mühe
Maik

AW: letzte Eintagung
08.06.2008 19:38:00
Josef
Hallo Maik,
kein Problem.
Sub Daten_eintragen()
Dim objWb As Workbook, objSh As Worksheet, objThisSheet As Worksheet
Dim strFile As String

On Error GoTo ErrExit

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

strFile = "C:\Artikelliste\Preisliste.xls" 'Datei in die geschrieben wird - Anpassen!

Set objThisSheet = ThisWorkbook.Sheets("Tabelle1") 'Tabellenblatt mit dem Formular - Anpassen!
Set objWb = Workbooks.Open(strFile)
Set objSh = objWb.Sheets("Tabelle1") 'Tabelle in die geschrieben wird - Anpassen!


'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
    If .[b3] <> "" And .[d3] <> "" Then
        objSh.Rows(3).Insert
        .Unprotect
        'Daten eintragen
        objSh.Cells(3, 1) = .[b3]
        objSh.Cells(3, 2) = .[d3]
        objSh.Cells(3, 3) = .[b5]
        objSh.Cells(3, 4) = .[d5]
        objSh.Cells(3, 5) = .[b7]
        objSh.Cells(3, 6) = .[d7]
        objSh.Cells(3, 7) = .[b9]
        objSh.Cells(3, 8) = .[d9]
        objSh.Cells(3, 9) = .[b11]
        objSh.Cells(3, 10) = .[d11]
        objSh.Cells(3, 11) = .[b13]
        objSh.Cells(3, 12) = .[d13]
        'Eingaben löschen
        .[b3:b13] = ""
        .[d3:d13] = ""
        .Protect
    Else
        MsgBox "Bitte Namen eintragen"
    End If
End With

objWb.Close True

ErrExit:

If Err.Number > 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

Set objWb = Nothing
Set objSh = Nothing
Set objThisSheet = Nothing
End Sub


Gruß Sepp



Anzeige
AW: letzte Eintragung
08.06.2008 19:58:34
Maiks
Hallo Sepp,
es funktioniert! danke dir!
noch zwei kleinkeiten:
1- ich habe grade bemerkt, dass:
wenn die Datei Preisliste.xls schon geöffnet ist, der Makro macht die Datei zu nach der Eintragung.
ich finde sehr schön, dass der Makro nicht die Datei öffnen müss bevor er die Daten einträgt. (es ist gut, gefällt mir)
aber wenn, die Datei schön öffnet ist, kann er nicht die Einträgung machen trotz die Datei öffnet bleibt?
es wäre sehr sehr schön wenn du das hinkrigen kannst!
2- meine zweite Frage ist eine allgemeine Frage, da ich noch ein A bei Makro programmierung bin.
irgendwo in dem Makro steht das hier:
'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
If .[b3] "" And .[d3] "" Then
weil er prüft nur 2 Zelle!
wenn ich mehre als zwei Zelle prüfen müss, kann ich so umschreiben?
'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
If .[b3] "" ; .[b4];.[b5] and .[d3] "" Then
danke für deine Rückmeldung
Maik

Anzeige
AW: letzte Eintragung
08.06.2008 21:39:00
Josef
Hallo Maik,
das geht auch. Zellen die du auf einen Eintrag prüfen willst, musst du einzeln angeben.
Sub Daten_eintragen()
Dim objWb As Workbook, objSh As Worksheet, objThisSheet As Worksheet
Dim strFile As String
Dim IsOpen As Boolean

On Error GoTo ErrExit

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

strFile = "C:\Artikelliste\Preisliste.xls" 'Datei in die geschrieben wird - Anpassen!

Set objThisSheet = ThisWorkbook.Sheets("Tabelle1") 'Tabellenblatt mit dem Formular - Anpassen!

For Each objWb In Application.Workbooks
    If objWb.FullName = strFile Then
        IsOpen = True
        Exit For
    End If
Next

If Not IsOpen Then Set objWb = Workbooks.Open(strFile)

Set objSh = objWb.Sheets("Tabelle1") 'Tabelle in die geschrieben wird - Anpassen!

'nur wenn in B3 und D3 etwas drinsteht dann eintragen
With objThisSheet
    If .[b3] <> "" And .[b4] <> "" And .[b5] <> "" And .[d3] <> "" Then
        objSh.Rows(3).Insert
        .Unprotect
        'Daten eintragen
        objSh.Cells(3, 1) = .[b3]
        objSh.Cells(3, 2) = .[d3]
        objSh.Cells(3, 3) = .[b5]
        objSh.Cells(3, 4) = .[d5]
        objSh.Cells(3, 5) = .[b7]
        objSh.Cells(3, 6) = .[d7]
        objSh.Cells(3, 7) = .[b9]
        objSh.Cells(3, 8) = .[d9]
        objSh.Cells(3, 9) = .[b11]
        objSh.Cells(3, 10) = .[d11]
        objSh.Cells(3, 11) = .[b13]
        objSh.Cells(3, 12) = .[d13]
        'Eingaben löschen
        .[b3:b13] = ""
        .[d3:d13] = ""
        .Protect
    Else
        MsgBox "Bitte Namen eintragen"
    End If
End With

If Not IsOpen Then objWb.Close True

ErrExit:

If Err.Number > 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

Set objWb = Nothing
Set objSh = Nothing
Set objThisSheet = Nothing
End Sub


Gruß Sepp



Anzeige
AW: letzte Eintragung
08.06.2008 22:00:52
Maiks
Hallo Sepp,
danke dir vielmals
funktioniert 100 pro
viele Grüße
Maik

AW: Dateneingabe ohne Userform
08.06.2008 19:06:00
Daniel
Hi
erstenmal wäre es hilfreich, wenn du schreiben würdest in welcher Programmzeile der Fehler auftritt.
wenn der von dir beschriebene Fehler auftritt (Index außerhalb des gülitgen bereichs), dann musst du prüfen, ob die Schreibweisen der Datei- oder Tabellenblattnamen im Makro korrekt sind.
falls nicht, müssen diese angepasst werden.
Außderdem,die Datei "Preisliste.xls" muss bei meinem Makro schon geöffnet sein, daß Öffnen dieser Datei habe ich nicht ins Makro eingebaut.
Gruß, Daniel

Anzeige
AW: Dateneingabe ohne Userform
08.06.2008 19:18:02
Maiks
vielen vielen dank an euch beide!!!
Sepp, dankschön, es funktiniert einwandfrei! danke sehr
Daniel, werde ich mich mit deinem Code auch weiterhin beschäftigt
Maik

Links zu Excel-Dialogen

UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige