Daten übertragen

Forumthread: Daten übertragen

Daten übertragen

22.06.2005 15:29:06

Betro

Hallo, ich habe folgenden Code geschriebeb s.u., aber der ist zu lang und wechselt immer wieder die Tabelle. Dies iritiert. Gibt es eine Möglichkein dies zu vereinfachen


Sub save()
' Datum Makro
' Makro am 22.06.2005 von zander aufgezeichnet
'Nr.
Sheets("Datenbank").Select
Range("Zahl").Select
Selection.Copy
Sheets("Datenbank").Select
Range("Zahl").Value = Range("Zahl").Value + 1
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Else
Range("A2").Select
End If
ActiveSheet.Paste
'Kunden-Daten
Sheets("Eingabe").Select
Range("Firma1").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Else
Range("B2").Select
End If
ActiveSheet.Paste
Sheets("Eingabe").Select
Range("Firma2").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 2).Select
Else
Range("C2").Select
End If
ActiveSheet.Paste
Sheets("Eingabe").Select
Range("Abt").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 3).Select
Else
Range("D2").Select
End If
ActiveSheet.Paste
Sheets("Eingabe").Select
Range("Name").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 4).Select
Else
Range("E2").Select
End If
ActiveSheet.Paste
Sheets("Eingabe").Select
Range("Strasse").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 5).Select
Else
Range("F2").Select
End If
ActiveSheet.Paste
Sheets("Eingabe").Select
Range("PLZ").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 6).Select
Else
Range("G2").Select
End If
ActiveSheet.Paste
Sheets("Eingabe").Select
Range("Ort").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 7).Select
Else
Range("H2").Select
End If
ActiveSheet.Paste
Sheets("Eingabe").Select
Range("Tel").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 8).Select
Else
Range("I2").Select
End If
ActiveSheet.Paste
Sheets("Eingabe").Select
Range("Fax").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 9).Select
Else
Range("J2").Select
End If
ActiveSheet.Paste
Sheets("Eingabe").Select
Range("Mail").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 10).Select
Else
Range("K2").Select
End If
ActiveSheet.Paste
Sheets("Eingabe").Select
Range("Werbung").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 11).Select
Else
Range("L2").Select
End If
ActiveSheet.Paste
'Datum
Sheets("Eingabe").Select
Range("Datum").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 12).Select
Else
Range("A2").Select
End If
ActiveSheet.Paste
'Bearbeiter
Sheets("Eingabe").Select
Range("Bearbeiter").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") <> "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 13).Select
Else
Range("A2").Select
End If
ActiveSheet.Paste
Sheets("Eingabe").Select
Range("C2").Select
'Löschen Makro
'Tastenkombination: Strg+n
Range("C2:C12").Select
'Range("A14").Activate
Selection.ClearContents
Range("C2").Select
End Sub

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten übertragen

22.06.2005 15:41:50

Harald
AW: Daten übertragen

22.06.2005 15:51:05

IngGi
AW: Daten übertragen

22.06.2005 15:52:53

IngGi
AW: Daten übertragen

22.06.2005 15:52:13

Mag
AW: Daten übertragen

22.06.2005 15:56:40

UweD
AW: Daten übertragen

23.06.2005 08:14:57

Betro
AW: Daten übertragen

23.06.2005 10:00:37

IngGi
AW: Daten übertragen

23.06.2005 10:05:08

UweD
AW: Daten übertragen

23.06.2005 15:03:51

Betro
Bitte mal Datei hochladen

24.06.2005 07:52:29

UweD

AW: Daten übertragen

22.06.2005 15:41:50

Harald

Hi Betro,
auf Select kann fast immer verzichtet werden.
Deine ersten 3 Codezeilen lassen sich z.B so zusammenfassen
Sheets("Datenbank").Range("Zahl").Copy
application.screenupdating = false
an den Anfang des Codes und
application.screenupdating = false ans Ende
Gruß
Harald

AW: Daten übertragen

22.06.2005 15:51:05

IngGi

Hallo Betro,
das ist dein erster Befehlsblock für Kundendaten:
Sheets("Eingabe").Select
Range("Firma1").Select
Selection.Copy
Sheets("Datenbank").Select
Range("A1").Select
If Range("A2") "" Then
Range("A1").End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Else
Range("B2").Select
End If
ActiveSheet.Paste
Daraus wird:
Sheets("Eingabe").Range("Firma1").Copy
With Sheets("Datenbank")
If .Range("A2") "" Then
.Range("A1").End(xlDown).Offset(0, 1).PasteSpecial Paste:=xlPasteAll
Else
.Range("B2").PasteSpecial Paste:=xlPasteAll
End If
Die anderen Blöcke nach dem selben Muster.
Gruß Ingolf

AW: Daten übertragen

22.06.2005 15:52:53

IngGi

Hallo Betro,
Korrektur meines Codes:
Sheets("Eingabe").Range("Firma1").Copy
With Sheets("Datenbank")
If .Range("A2") "" Then
.Range("A1").End(xlDown).Offset(0, 1).PasteSpecial Paste:=xlPasteAll
Else
.Range("B2").PasteSpecial Paste:=xlPasteAll
End If
End With
Gruß Ingolf

AW: Daten übertragen

22.06.2005 15:52:13

Mag

Hallo,
du solltest direkte adressierungen wählen. Beispiel:
statt 'Sheets("Datenbank").Select : Range("Zahl").Value =xy'
sollte 'Worksheets("Datenbank").Range("Zahl").Value=xy'
oder 'Worksheets("Datenbank").Cells(y,x).Value=xy' stehen,
dann hat es ein Ende mit Tabellenspringen. Außerdem ist die
Ausführung wesentlich schneller.
Gruß Mag

AW: Daten übertragen

22.06.2005 15:56:40

UweD

Hallo
hier mal eine Verkürzung des ersten Blocks.


Sub save()
'Nr.
With Sheets("Datenbank").Range("Zahl")
If Range("A2") <> "" Then
.Copy Destination:=Range("A1").End(xlDown).Offset(1, 0)
Else
.Copy Destination:=Range("A2")
End If
End With
Sheets("Datenbank").Range("Zahl").Value = Range("Zahl").Value + 1
'Kunden-Daten
End Sub

Der Rest kann analog dazu aufgebaut werden

AW: Daten übertragen

23.06.2005 08:14:57

Betro

Hallo Mag,
wie würden Sie den zweite Block schreiben?
Da bei der ersten nich das grosse broblem sehe sondern ab zweiten.

AW: Daten übertragen

23.06.2005 10:00:37

IngGi

Hallo Mag,
meine Antwort bezieht sich auf den zweiten Block.
Gruß Ingolf

AW: Daten übertragen

23.06.2005 10:05:08

UweD

Hallo
hier erster und Zweiter Block:

Sub save()
    Set Db = Sheets("Datenbank")
'Nr.
    If Range("A2") <> "" Then
        Db.Range("Zahl").Copy Db.Range("A1").End(xlDown).Offset(1, 0)
    Else
        Db.Range("Zahl").Copy Db.Range("A2")
    End If
    Db.Range("Zahl").Value = Range("Zahl").Value + 1

'Kunden-Daten
    With Sheets("Eingabe")
        If Range("A2") <> "" Then
            .Range("Firma1").Copy Db.Range("A1").End(xlDown).Offset(0, 1)
            .Range("Firma2").Copy Db.Range("A1").End(xlDown).Offset(0, 2)
            .Range("Abt").Copy Db.Range("A1").End(xlDown).Offset(0, 3)
            .Range("Name").Copy Db.Range("A1").End(xlDown).Offset(0, 4)
            .Range("Strasse").Copy Db.Range("A1").End(xlDown).Offset(0, 5)
            .Range("PLZ").Copy Db.Range("A1").End(xlDown).Offset(0, 6)
            'usw.
        Else
            .Range("Firma1").Copy Db.Range("B2")
            .Range("Firma2").Copy Db.Range("C2")
            .Range("Abt").Copy Db.Range("D2")
            .Range("Name").Copy Db.Range("E2")
            .Range("Strasse").Copy Db.Range("F2")
            .Range("PLZ").Copy Db.Range("G2")
            'usw.
        End If

    End With
'...
End Sub

der Rest analog
Gruß UweD

AW: Daten übertragen

23.06.2005 15:03:51

Betro

Hallo ich haber dies übernohmen und vollständig geschrieben, aber dies fühlt die ganzen Zeilen nit den Inhalt aus der Zelle des Zahls
Gruß Betro

Bitte mal Datei hochladen

24.06.2005 07:52:29

UweD

Hallo
..damit wir weiter helfen können.
Es ist immer schwierig erst alles selbst nachzubauen um es zu testen..
Gruß UweD

Beliebteste Forumthreads (12 Monate)

Forumthread: Daten übertragen

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

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread