Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1568to1572
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Excel/Makro Kopie

Excel/Makro Kopie
25.07.2017 15:41:42
fredde
Hallo zusammen,
ich habe folgendes Problem/Anliegen:
Meine Ausgangstabelle (Tabelle1) soll mit allen Spalten/Zeilen in Tabelle2 kopiert werden, wenn in Spalte E ab Zeile 3 bis 200 das Wort Equities steht. Zusätzlich sollen die ersten beiden Zeilen, also Zeile 1-2 ohne Bedingung kopiert werden. Meine Tabelle "geht" bis Q und bis zur Zeile 200.
Meine Frage lautet: Wie muss der Makro Code dafür aussehen?
Super vielen Dank im Voraus!!
Grüße
fredde

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel/Makro Kopie
25.07.2017 16:01:50
Michael
Hallo!
zB so, unter der Annahme, dass Tabelle2 (das Ziel-Blatt) bereits in der Mappe existiert:
Sub a()
Const SUCH$ = "Equities" 'In Zellen gesuchter Begriff
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1") 'Quell-Blatt
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2") 'Ziel-Blatt
Dim f As Range
Application.ScreenUpdating = False
'Kopieren OHNE Bedingung
WsQ.Range("A1:Q2").Copy WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Offset(1, 0)
'Kopieren MIT Bedingung
Set f = WsQ.Range("E3:E200").Find(SUCH, LookIn:=xlValues, lookat:=xlPart)
If Not f Is Nothing Then
WsQ.Range("A3:Q200").Copy WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing: Set f = Nothing
End Sub
LG
Michael
Anzeige
AW: Excel/Makro Kopie
25.07.2017 16:18:55
fredde
Danke!
Leider werden auch die Zeilen kopiert, die in der Spalte E nicht das Wort Equities haben.
AW: Excel/Makro Kopie
25.07.2017 16:39:01
Michael
Leider werden auch die Zeilen kopiert, die in der Spalte E nicht das Wort Equities haben
Ja, denn das ist was Du, gemäß Deinem Beitrag, haben wolltest. Ich darf Dich zitieren:
Meine Ausgangstabelle (Tabelle1) soll mit allen Spalten/Zeilen in Tabelle2 kopiert werden, wenn in Spalte E ab Zeile 3 bis 200 das Wort Equities steht.
Das heißt für mich, sobald "Equities" irgendwo in E3:E300 vorkommt, wird das gesamte Blatt kopiert.
Was Du nun beschreibst muss anders laufen, zB über AutoFilter. Meine Frage dazu: Kommt in den ersten beiden Zeilen "Equities" niemals vor? Wenn schon, immer? Oder KANN es da vorkommen, muss aber nicht?
LG
Michael
Anzeige
AW: Excel/Makro Kopie
25.07.2017 16:24:44
Hajo_Zi
benutze Autofilter und kopiere den sichtbaren Bereich.

Ich gebe keinen Dank für eine Rückmeldung, da ich durch solche Beiträge nicht meine Beitragszahl erhöhen muss.
Rückmeldung ist ja in der Heutigen Zeit nicht üblich und die wenigen die eine Rückmeldung geben, mögen mir das verzeihen, das kein Danke für eine Rückmeldung kommt.
AW: Excel/Makro Kopie
25.07.2017 20:34:30
fcs
Hallo Fredde,
der "einfachste" Weg ist, das komplette Blatt kopieren und dann die Filteraktionen ausführen.
Dann braucht man sich nach dem Kopieren um Formatierungen nicht mehr kümmern.
Ich hab dir mal 2 Varianten angehängt.
Insbesondere bei vielen Zeilen ist der Autofilter der effektivere Weg.
LG
Franz

Sub Daten_Kopieren_Filtern()
'Verwendung des Autofilters
Dim wks As Worksheet
Dim Zei_T As Long
Dim Zei_L As Long
Dim wksCopy As Worksheet
Dim bolAutofilter As Boolean
Set wks = ActiveWorkbook.Worksheets(1) 'oder  Worksheets("Tabelle1")
wks.Copy after:=wks
Set wksCopy = ActiveSheet
Application.ScreenUpdating = False
With wksCopy
.Name = "Tab " & Format(Now, "YYYY-MM-DD hh_mm_ss")
Zei_T = 2 'Zeile mit Spaltentiteln über den Daten
'Prüfen, ob Autofilter aktiv
If .FilterMode = True Then
bolAutofilter = True
.ShowAllData
End If
'letzte benutzte Zeile
Zei_L = .UsedRange.Row + .UsedRange.Rows.Count - 1
If Zei_L >= 3 Then
'Filterin Spalte E setzen
.Range(.Rows(Zei_T), .Rows(Zei_L)).AutoFilter Field:=5, Criteria1:="Equities"
'in Spalte E die sichtbaren Zellen markieren und die Zeilen löschen
With .Range(.Cells(Zei_T + 1, 5), .Cells(Zei_L, 5))
On Error Resume Next
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
Err.Clear
End With
'alle Daten anzeigen
.ShowAllData
If bolAutofilter = False Then .AutoFilterMode = False
Else
MsgBox "keine Daten vorhanden"
End If
End With
Application.ScreenUpdating = True
End Sub
Sub Daten_Kopieren_Filtern_Variante()
'Löschen der abweichenden Inhalte in den Zellen Spalte E
Dim wks As Worksheet
Dim Zei
Dim Zei_1 As Long
Dim Zei_L As Long
Dim wksCopy As Worksheet
Set wks = ActiveWorkbook.Worksheets(1) 'oder  Worksheets("Tabelle1")
wks.Copy after:=wks
Set wksCopy = ActiveSheet
Application.ScreenUpdating = False
With wksCopy
.Name = "Tab " & Format(Now, "YYYY-MM-DD hh_mm_ss")
Zei_1 = 3 '1 Zeile mit Daten
'Wenn Filtermodus aktiv, dann alle Daten
If .FilterMode = True Then
.ShowAllData
End If
'letzte benutzte Zeile
Zei_L = .UsedRange.Row + .UsedRange.Rows.Count - 1
For Zei = Zei_1 To Zei_L
'in Spalte E Werte verschieden von "Equities" löschen
If .Cells(Zei, 5).Value  "Equities" Then .Cells(Zei, 5).ClearContents
Next Zei
'in Spalte E die sichtbaren Zellen markieren und die Zeilen löschen
With .Range(.Cells(Zei_1, 5), .Cells(Zei_L, 5))
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Err.Clear
End With
End With
Application.ScreenUpdating = True
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige