Bestimmte Zellen einer aktiven Zeile in ein anderes Arbeitsblatt der gleichen Tabelle kopieren

Question

Hallo zusammen,

leider bin ich was VBA belangt nicht so bewandert. Jetzt brauche ich
aber dringend ein Makro, das mir verschiedene Zellen eines
Quellarbeitsblattes in ein Zielarbeitsblatt kopiert.
Das Quellarbeitsblatt heißt "Bau-Reminder"
Zielarbeitsblatt heisst das "Mängel-Struktur"

1. Kopieren der folgenden Zellen der aktiven Zeile (z.b.40) A40, B40, C40, F40, L40 aus der Quelldatei

2. Einfügen in A8, B8, C8, D8,E8 in der Zieldatei (Zeile 8 ist Start)

3. Wenn Zeile 8 schon belegt ist, dann einfügen in 9. Wenn 9 schon
belegt ist, dann 10, usw.

4. Beim Einfügen sollen die Werte eingefügt werden (ohne Formel).
Das Zahlenformat sollte aber beibehalten werden.

5. Ideal wäre es, wenn es einen Button gäbe, der einen auffordert
die Quellzeile des Quellarbeitsblattes auszuwählen.

Vielen Dank im Voraus

Answer 1

Hallo,

schau mal ob das so passt:

Sub kopieren()

Dim Eingabe As Variant
Dim lngZeile As Long
Dim lngletzte As Long
Dim arrSpalten
Dim lngSpalten As Long

'Spalten A, B, C, F und L
arrSpalten = Array(1, 2, 3, 6, 12)

Eingabe = InputBox("Bitte geben die zu kopierende Zeile ein (nur ganze Zahlen)!", "Eingabe")

'Abbruch falls keine Eingabe erfolgt
If Eingabe = "" Then
MsgBox "Abbruch, da keine Eingabe erfolgt ist!", 16, "Abbruch!"
Exit Sub
End If

'Abbruch, falls Eingabe keine Zahl ist
If IsNumeric(Eingabe) = False Then
MsgBox "Abbruch, da Eingabe keine Zahl ist!", 16, "Abbruch!"
Exit Sub
End If

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'letzte Zeile in Spalte A im Zielarbeitsblatt ermitteln
lngletzte = Worksheets("Mängel-Struktur").Cells(Rows.Count, 1).End(xlUp).Row + 1

'prüfen, ob letzte Zeile kleiner als 8, falls ja, dann entsprechend erhöhen
If lngletzte < 8 Then lngletzte = 8

'Werte und Formate kopieren
For lngSpalten = 1 To 5
Worksheets("Bau-Reminder").Cells(Eingabe, arrSpalten(lngSpalten - 1)).Copy
With Worksheets("Mängel-Struktur").Cells(lngletzte, lngSpalten)
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
Next lngSpalten
Application.CutCopyMode = False

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

MsgBox "Die Daten wurden kopiert!", 64, "Kopieren beendet"

End Sub

Das Makro gehört in ein Standard Modul deiner Arbeitsmappe.
Den Button musst du dir aber schon selber in die Tabelle einfügen ;-).

Gruß

M.O.