Zellen in anderes Arbeitsblatt kopieren
Stefan
Ich habe eine Quell- und eine Zieldatei in jeweils verschiedenen Arbeitsmappen. Beide Dateien haben die gleiche Struktur.
dazu habe ich folgenden Code, der mir hier zur Verfügung gestellt wurde:
Private Sub CommandButton1_Click()
Dim wksQuelle As Worksheet
Dim rngRow As Range, rngSelektion As Range
Dim wbSammler As Workbook, wksSammler As Worksheet, rngZelle As Range
Dim vKey As Variant, lZeile As Long
'Spalte mit eindeutgem Schlüssel = Spalte B
Const SpalteKey As Long = 2
'Dateiname der Sammeldatei - anpassen !
Const sNameSammler As String = "\\\\Malibu\Projekte\SAP\300_Test\2011\110_Verwaltung\ _
20_Auswertungen\Workflow_GSZ_2011.xlsm"
'Blattname oder Nr des Tabellenblatts in Sammeldatei - ggf. anpassen !
Const vBlattSammler = 1
On Error GoTo Fehler
'Quellblatt und Zell-Selektion Objekt-Variablen zuweisen
Set wksQuelle = ActiveSheet
Set rngSelektion = Selection
'1. Zeile des selektierten Bereichs prüfen
If rngSelektion.Row Sammeldatei") = vbNo Then GoTo Beenden
'Bildschirmaktualisierung und Ereignismakros deaktivieren
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Sammeldatei öffnen
Set wbSammler = Workbooks.Open(Filename:=sNameSammler, Ignorereadonlyrecommended:=True)
Set wksSammler = wbSammler.Worksheets(vBlattSammler)
'Keys der Selektion in Sammeldatei suchen und Zeilen kopieren
For Each rngRow In rngSelektion.Rows
vKey = wksQuelle.Cells(rngRow.Row, SpalteKey).Value
Set rngZelle = wksSammler.Columns(SpalteKey).Find(What:=vKey, LookIn:=xlValues, _
lookat:=xlWhole)
With wksSammler
If rngZelle Is Nothing Then
'Neuer Schlüssel
lZeile = .Cells(.Rows.Count, SpalteKey).End(xlUp).Row + 1
Else
'vorhandener Schlüssel
lZeile = rngZelle.Row
End If
End With
wksQuelle.Rows(rngRow.Row).Copy Destination:=wksSammler.Rows(lZeile)
Next
wbSammler.Close savechanges:=True
Beenden:
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Der Code leistet folgendes:
Anwender/in gibt in eine Zeile der Quelldatei Daten ein, markiert die Zeile, klickt auf einen Button, im Hintergrund öffnet sich die Zieldatei, die eingegebenen Daten werden in die Zieldatei kopiert, Zieldatei wird geschlossen (dabei sind die Daten in Spalte B einmalig, d. h. der Code vergleicht den Eintrag von Quelldatei Spalte B mit Eintrag Zieldatei Spalte B, ist der Eintrag schon vorhanden wird in Zieldatei die entsprechende Zeile überschrieben, falls noch nicht vorhanden am Ende angefügt).
Mein Problem:
Ist es möglich, daß der Anwender statt die ganze Zeile zu markieren und dann eben diese Zeile in Zieldatei
kopiert wird einzelne Zellen markiert und diese dann kopiert in die Zieldatei?
Viele Grüße
Stefan