Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1616to1620
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
Inhaltsverzeichnis

Werte aus Tabelle 1 nach Tabelle 2 kopieren

Werte aus Tabelle 1 nach Tabelle 2 kopieren
01.04.2018 19:42:47
Stanley69
Hei Peter(silie),
vielen Dank für deine Unterstützung. Das Makro läuft für die Übernahme aller Daten läuft perfekt.
Du hattest mich gefragt, ob ich alle, oder nur bestimmte Daten aus der Tabelle "Hollern" kopieren möchte.
Ich möchte nur bestimmte Daten aus der Tabelle kopieren. Bitte schaue die einmal die Excel-Datei an.
Für deine Unterstützung bedanke ich mich im voraus.
Gruß
Stanley69
https://www.herber.de/bbs/user/120794.xlsm

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte aus Tabelle 1 nach Tabelle 2 kopieren
02.04.2018 11:14:00
Peter(silie)
Hallo,
hier deine Mappe: https://www.herber.de/bbs/user/120799.xlsm
Da der Code ohne Copy und PasteSpecial funktioniert, sollte er auch
bei großen Datenmengen noch relativ schnell sein.
Hier nur der Code:
Option Explicit
'Enum containing the
'Columns we need in Sheet Kegler
'Change those numbers if neccessary
Private Enum Kxy
Holz = 27
Ueber = 32
Neuer = 41
Pudel = 45
End Enum
'Same like Kxy but for Hollern
Private Enum Hxy
Holz = 87
Ueber = 88
Neuer = 96
Pudel = 103
End Enum
Public Sub CopyData()
'SetValues need an Array of Values
'The Function GetValues will return this
'you can directly pass the GetValues
'Function to the SetValues Sub
'The Sub CopyData is unneccessary
'You can just add a Button
'with line of Code below.
SetValues GetValues
End Sub
Private Sub SetValues(ByRef kValues As Variant)
Dim shTarget    As Worksheet    'data target sheet
Dim lRow        As Long         'last row
Set shTarget = ThisWorkbook.Sheets("Kegler")
With shTarget
lRow = .Cells(.Rows.Count, Kxy.Holz).End(xlUp).Row + 1
.Range(.Cells(lRow, Kxy.Holz), .Cells(lRow, Kxy.Holz)).Resize( _
UBound(kValues) + 1).Value = kValues(1)
lRow = .Cells(.Rows.Count, Kxy.Ueber).End(xlUp).Row + 1
.Range(.Cells(lRow, Kxy.Ueber), .Cells(lRow, Kxy.Ueber)).Resize( _
UBound(kValues) + 1).Value = kValues(2)
lRow = .Cells(.Rows.Count, Kxy.Neuer).End(xlUp).Row + 1
.Range(.Cells(lRow, Kxy.Neuer), .Cells(lRow, Kxy.Neuer)).Resize( _
UBound(kValues) + 1).Value = kValues(3)
lRow = .Cells(.Rows.Count, Kxy.Pudel).End(xlUp).Row + 1
.Range(.Cells(lRow, Kxy.Pudel), .Cells(lRow, Kxy.Pudel)).Resize( _
UBound(kValues) + 1).Value = kValues(4)
End With
End Sub
Private Function GetValues() As Variant
Dim shSource    As Worksheet    'data source sheet
Dim vData       As Variant      'variant data of range
Dim lRow        As Long         'last row
ReDim vData(1 To 4)
Set shSource = ThisWorkbook.Sheets("Hollern")
With shSource
'Data of the Column containing the Holz Data
lRow = .Cells(.Rows.Count, Hxy.Holz).End(xlUp).Row
vData(1) = .Range(.Cells(2, Hxy.Holz), _
.Cells(lRow, Hxy.Holz)).Value
'Data of the Column containing the Über Data
lRow = .Cells(.Rows.Count, Hxy.Ueber).End(xlUp).Row
vData(2) = .Range(.Cells(2, Hxy.Ueber), _
.Cells(lRow, Hxy.Ueber)).Value
'Data of the Column containing the Neuer Data
lRow = .Cells(.Rows.Count, Hxy.Neuer).End(xlUp).Row
vData(3) = .Range(.Cells(2, Hxy.Neuer), _
.Cells(lRow, Hxy.Neuer)).Value
'Data of the Column containing the Pudel Data
lRow = .Cells(.Rows.Count, Hxy.Pudel).End(xlUp).Row
vData(4) = .Range(.Cells(2, Hxy.Pudel), _
.Cells(lRow, Hxy.Pudel)).Value
End With
'Pass the Array to the Function
GetValues = vData
End Function

Anzeige
AW: Werte aus Tabelle 1 nach Tabelle 2 kopieren
02.04.2018 12:31:18
Stanley69
Hei Peter(silie),
vielen Dank für deine Unterstützung. Es läuft alles perfekt.
Habe einiges dazu gelernt.
Gruß
Stanley69

312 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige