Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
624to628
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
624to628
624to628
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige