meine ersten Schritte in VBA bestehen darin über Google Lösungen zu finden und diese auf meine Bedürfnisse anzupassen.
Aktuell habe ich den Großteil schon gelöst (nicht elegant aber zielführend), aber am Schluss hackt es an einer Kleinigkeit.
Im folgenden seht ihr mein VBA Code: Ich möchte das die kopierten Werte aus dem Tabellenblatt „Quelle“ in das Zieltabellenblatt „Gerhard“ erst ab der zweiten Zeile kopiert werde, damit ich die Kopfzeile behalten kann.
bei den Variablen sollte man ggf. Namen verwenden, die etwas aussagekräftiger sind. Auch sollte man die Variablen mit As als den Typ deklarieren, den sie repräsentieren sollen. So wird das Programmieren etwas einfacher.
Um das Einfügen nicht in Zeile 1 zu beginnen, muss du vor der Do…Loop-Schleife auf den Wert setzen, nach dem mit dm Einfügen begonnen werden soll.
Auf Activate und Select/Selection kann man in den meisten Fällen ebenfalls verzichten und die betroffenen Objekte direkt angeben. Activate und Select/Selection sind meist Überreste eines vom Makro-Recorder aufgezeichneten Codes, die man entsprechend einkürzen kann.
Gruß
Franz
Sub Gerhard()
Dim oZelle As Range, firstaddress As String
Dim wksQuelle As Worksheet, wksZiel As Worksheet, Zei As Long
Set wksQuelle = Worksheets("Quelle")
Set wksZiel = Worksheets("Gerhard")
'Alle Daten iin Zieltabelle ab Zeile 2 löschen
With wksZiel
Zei = .Cells.SpecialCells(xlCellTypeLastCell).Row
If Zei \> 1 Then
.Range(.Rows(2), Rows(Zei)).Clear
End If
Zei = 1 'Zeile 1 bleibt frei für Überschrift
End With
With wksQuelle.UsedRange
Set oZelle = .Find("Gerhard", LookIn:=xlValues)
If Not oZelle Is Nothing Then
firstaddress = oZelle.Address
Do
Zei = Zei + 1
oZelle.EntireRow.Copy Destination:=wksZiel.Cells(Zei, 1)
Set oZelle = .FindNext(oZelle)
Loop While Not oZelle Is Nothing And oZelle.Address firstaddress
'Titelzeile kopieren - die nachfolgende Zeile ist ggf. nicht mehr erforderlich
wksQuelle.Rows("1:1").Copy Destination:=wksZiel.Rows("1:1")
End If
End With
End Sub
so wie ich das sehe, musst du nur vor der Zeile Zei = Zei + 1 die Zeile Zei = 1 einfügen, denn dann fängt Zei nicht bei 0, sondern 1 an und wird ja direkt um 1 auf 2 erhöht.
einfach Worksheets(„Gerhard“).Rows(„1:1“).Select
durch Worksheets(„Gerhard“).Rows(„2:2“).Select
ersetzen.
Kleiner Tipp:
Schau Dir mal die Website www.herber.de an, dann brauchst Du nicht mehr zu ggooglen - hier findest Du (fast) alle antworten zu Excelfragen.
Sub Gerhard()
Dim c, firstaddress, wks1 As Worksheet, wks2 As Worksheet, Zei As Long
Set wks1 = Worksheets("Quelle")
Set wks2 = Worksheets("Gerhard")
**wks2.Cells.Clear**
With wks1.UsedRange
Set c = .Find("Gerhard", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
**Zei = 2
Do
c.EntireRow.Copy Destination:=wks2.Cells(Zei, 1)
Zei = Zei + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address firstaddress
wks1.Rows("1:1").Copy Destination:=wks2.Rows("1:1")**
End If
End With
End Sub
meine ersten Schritte in VBA bestehen darin über Google
Lösungen zu finden und diese auf meine Bedürfnisse anzupassen.
Das sieht ja schon recht gut aus
Im folgenden seht ihr mein VBA Code: Ich möchte das die
kopierten Werte aus dem Tabellenblatt „Quelle“ in das
Zieltabellenblatt „Gerhard“ erst ab der zweiten Zeile kopiert
werde, damit ich die Kopfzeile behalten kann.
Irgendwelche Vorschläge?
Versuche es mal mit den folgenden Zeilen:
Option Explicit
Sub Gerhard()
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim c As Range
Dim firstaddress As String
Dim Zei As Long
Set wks1 = Worksheets("Quelle")
Set wks2 = Worksheets("Gerhard")
wks2 .Cells.Clear
With wks1.UsedRange
Set c = .Find("Gerhard", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Zei = 1
Do
Zei = Zei + 1
c.EntireRow.Copy Destination:=wks2.Cells(Zei, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address firstaddress
wks1.Rows(1).Copy \_
wks2.Rows(1)
End If
End With
End Sub
Hallo,
versuchs mal damit. Das Beispiel ist ausgelegt für 20 Spalten und unbegrenzte Zeilen!
Sub Kopieren()
Sheets(„Gerhard“).Activate
Dim aRow As Long, Datum As Date
aRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
Range(Cells(2, 1), Cells(aRow, 20)).Select
Selection.ClearContents
Cells(2, 1).Select
Sheets(„Quelle“).Activate
aRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
Range(Cells(2, 1), Cells(aRow, 20)).Select
Selection.Copy
Sheets(„Gerhard“).Activate
ActiveSheet.Paste
End Sub
hallo neuling, es sind ja schon viele vorschläge da. - alternativ könnte man, wenn „gerhard“ nur in einer spalte vorkommt, die gesamte quelltabelle auf die zieltabelle kopieren, dort nach der betreffenden spalte sortieren und alles unter- und oberhalb von „gerhard“ außer der 1.zeile löschen. solche lösungen bevorzuge ich gerade bei großen datenmengen, da ich do-loop-schleifen für langsam halte und gerne darauf verzichte . wenn gewünscht, schreibe ich das programm an dieser stelle. herzliche grüße und viel erfolg, ascan
leider fehlt in meinem letzten Script an dich noch eine Zeile. Anbei das bereinigte Script!
’ Kopiert die Daten von Tabelle zu
’ von Zeile-2 bis letzte Zeile
’ von Spalte-1 bis Spalte-20
Sub Kopieren()
Sheets(„Gerhard“).Activate
Dim aRow As Long
aRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
If aRow = 1 Then aRow = 2
Range(Cells(2, 1), Cells(aRow, 20)).Select
Selection.ClearContents
Cells(2, 1).Select
Sheets(„Quelle“).Activate
aRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
Range(Cells(2, 1), Cells(aRow, 20)).Select
Selection.Copy
Sheets(„Gerhard“).Activate
ActiveSheet.Paste
End Sub
kann leider erst jetzt antworten da ich im Urlaub war.
Ich vermute da sind viele schon schneller gewesen und
haben sich tolle Lösungen gegeben, daher keine von mir.
