gibt es mit VBA eine Möglichkeiten eine Bereich links neben der aktiven Zelle zu kopieren.
Also wie entirerow - activerzelle.select oder oo was...
Gruß und danke...
Andreas
Sub Kopie_Bereich()
Dim iRow%
Dim i$
Dim rzelle As Range
Dim rTestRange As Range
Set rTestRange = Sheets("Kopien").[q1:q8]
For Each rzelle In rTestRange.Cells
Sheets("Daten").Activate
With Worksheets("Daten").Range("Q1:Q10")
Set c = .Find(rzelle, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Set c = .FindNext(c)
c.Select
With Sheets("Kopien")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(ActiveCell.Row, 1), ActiveCell.Offset(0, -1)).Copy Worksheets("Kopien").Rows(iRow)
End With
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
Next rzelle
End Sub
Sub Kopie_Bereich()
Dim iRow%
Dim i$
Dim rzelle As Range
Dim rTestRange As Range
Set rTestRange = Sheets("Kopien").[p1:p8]
For Each rzelle In rTestRange.Cells
Sheets("Daten").Activate
With Worksheets("Daten").Range("Q1:Q10")
Set c = .Find(rzelle, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Set c = .FindNext(c)
c.Select
With Sheets("Kopien")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(ActiveCell.Row, 1), ActiveCell.Offset(0, -1)).Copy Worksheets("Kopien").Rows(iRow)
End With
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
Next rzelle
End Sub
Öffne Excel und drücke ALT + F11
, um den VBA-Editor zu öffnen.
Füge ein neues Modul hinzu: Einfügen > Modul
.
Kopiere den folgenden VBA-Code in das Modul:
Sub Kopie_Bereich()
Dim iRow%
Dim rzelle As Range
Dim rTestRange As Range
Set rTestRange = Sheets("Kopien").[p1:p8]
For Each rzelle In rTestRange.Cells
Sheets("Daten").Activate
With Worksheets("Daten").Range("Q1:Q10")
Set c = .Find(rzelle, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Set c = .FindNext(c)
With Sheets("Kopien")
iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(ActiveCell.Row, 1), ActiveCell.Offset(0, -1)).Copy Worksheets("Kopien").Cells(iRow, 1)
End With
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
Next rzelle
End Sub
Schließe den VBA-Editor und gehe zurück zu Excel.
Führe das Makro aus: Entwicklertools > Makros > Kopie_Bereich > Ausführen
.
Fehler: "Laufzeitfehler 1004: Anwendung oder Objektdefinierungsfehler"
Fehler: "Fehler beim Kopieren des Bereichs"
Falls Du keinen VBA-Code verwenden möchtest, kannst Du auch folgende Methoden ausprobieren:
Formeln: Verwende die Funktion =LINKS(A1;LÄNGE(A1)-1)
, um den Text links neben der aktiven Zelle zu extrahieren. Diese Methode ist jedoch manuell und weniger flexibel.
Excel-Add-Ins: Es gibt verschiedene Add-Ins, die erweiterte Funktionen für das Kopieren von Zellen bieten. Diese können eine benutzerfreundliche Oberfläche zur Verfügung stellen.
Beispiel 1: Wenn Du den Bereich links von der Zelle B2 kopieren möchtest, achte darauf, dass Dein Makro korrekt auf die aktive Zelle verweist. Die Zeile Range(Cells(ActiveCell.Row, 1), ActiveCell.Offset(0, -1)).Copy
sorgt dafür, dass der Bereich A2 kopiert wird.
Beispiel 2: Wenn Du mehrere Zellen in einem Bereich (z.B. P1:P8) durchsuchst, kannst Du den Inhalt von Spalte A bis P in das Blatt "Kopien" übertragen.
Optimierung des Codes: Verwende Application.ScreenUpdating = False
, um die Bildschirmaktualisierung während des Makros zu deaktivieren, was die Ausführung beschleunigt.
Fehlerbehandlung: Implementiere eine Fehlerbehandlung, um unerwartete Probleme zu vermeiden. Beispiel:
On Error GoTo Fehlerbehandlung
' Dein Code hier
Exit Sub
Fehlerbehandlung:
MsgBox "Ein Fehler ist aufgetreten: " & Err.Description
1. Kann ich das Makro auf andere Bereiche anpassen?
Ja, Du kannst die Bereiche in Set rTestRange = Sheets("Kopien").[p1:p8]
und Range("Q1:Q10")
nach Deinen Bedürfnissen anpassen.
2. Was mache ich, wenn das Makro nicht funktioniert? Überprüfe die Blattnamen und Zellenbereiche. Stelle sicher, dass Du das Makro in einer unterstützten Excel-Version ausführst (z.B. Excel 2016 oder neuer).
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen