Seite wählen

Daten in andere Tabelle übertragen

VBA

Dieses kleines Script in VBA dient zur gezielten Übertragung von Daten aus einem Tabellenblatt ins andere. Das Script wird immer dann ausgeführt, wenn die Arbeitsmappe entweder geöffnetgespeichert oder gedruckt wird.

 

DieseArbeitsmappe

Dim count As Integer

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Modul1.DS_hinzufuegen
End Sub

Private Sub Workbook_Open()
  Range("A4:C35").Select
  Selection.ClearContents
  Range("E1").Select
  Selection.ClearContents
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Modul1.DS_hinzufuegen
End Sub

Erläuterung 

Drucken: 

Private Sub Workbook_BeforePrint(Cancel As Boolean)

Speichern: 

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Öffnen: 

Private Sub WorkbookOpen()

 

Modul1

Sub ClearTable()

    Range("A4:C35").Select
    Selection.ClearContents
    Range("E1").Select
    Selection.ClearContents
    
End Sub

Dim QuelleTabelle As String
Dim ZielTabelle As String

Sub DS_hinzufügen()
    Dim Location As String, SerialNumber As String, User As String, Gerätebeschreibung As String
    
    Tabelle1.Select
    
    Location = Range("E1")                              
    Gerätebeschreibung = Range("A4")              
    SerialNumber = Range("B4")                        
    User = Range("C4")                                      
    
    
    Tabelle2.Select
    Tabelle2.Range("A1").Select
    If Tabelle2.Range("A1").Offset(1, 0) <> "" Then
    
        Tabelle2.Range("A1").End(xlDown).Select
    
    End If
    
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = Gerätebeschreibung
    
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = SerialNumber
    
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = User
    
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Location
    
    Tabelle1.Select
    
    Range("A4:C35").Select
    Selection.ClearContents
    Range("E1").Select
    Selection.ClearContents
    
End Sub

0 Kommentare

Einen Kommentar abschicken

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert.