Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
23.04.2024 21:29:56
Bestimmte Zellen auf andere Arbeitsblätter kopieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1812to1816
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1812to1816
1812to1816
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA kopieren wenn

VBA kopieren wenn
25.02.2021 15:55:41
Nicole
Guten Tag
Ich möchte Daten von einem Tabellenblatt in zwei andere kopieren, wenn eine Bedingung erfüllt ist.
Wenn auf dem Tabellenblatt "Mastertabelle" in der Spalte A "DD" steht, soll auf das Tabellenblatt "DD" kopiert werden,
Wenn auf dem Tabellenblatt "Mastertabelle" in der Spalte A "SI" steht, soll auf das Tabellenblatt "SI" kopiert werden.
Beim einfügen auf dem entsprechenden Tabellenblatt sollen nur die Werte, nicht die Formeln eingefügt werden.
Im Moment habe ich das so gelöst:
Sub DatenKopierenDD()
Dim i%
With Sheets("Mastertabelle")
For i = 6 To 400
If .Cells(i, 1) = "DD" Then
Sheets("Mastertabelle").Range("E6:E400").Copy
Sheets("DD").Range("C41:C150").PasteSpecial Paste:=xlPasteValues
Sheets("Mastertabelle").Range("G6:L400").Copy
Sheets("DD").Range("D41:I150").PasteSpecial Paste:=xlPasteValues
Sheets("Mastertabelle").Range("M6:M400").Copy
Sheets("DD").Range("M41:M150").PasteSpecial Paste:=xlPasteValues
Sheets("Mastertabelle").Range("N6:R400").Copy
Sheets("DD").Range("N41:R150").PasteSpecial Paste:=xlPasteValues
Sheets("Mastertabelle").Range("w6:w400").Copy
Sheets("DD").Range("s41:s150").PasteSpecial Paste:=xlPasteValues
End If
Next i
End With
End Sub

Sub DatenKopierenSI()
Dim i%
With Sheets("Mastertabelle")
For i = 6 To 400
If .Cells(i, 1) = "SI" Then
Sheets("Mastertabelle").Range("E6:E400").Copy
Sheets("SI").Range("C41:C150").PasteSpecial Paste:=xlPasteValues
Sheets("Mastertabelle").Range("G6:L400").Copy
Sheets("si").Range("D41:I150").PasteSpecial Paste:=xlPasteValues
Sheets("Mastertabelle").Range("M6:M400").Copy
Sheets("SI").Range("M41:M150").PasteSpecial Paste:=xlPasteValues
Sheets("Mastertabelle").Range("N6:R400").Copy
Sheets("SI").Range("N41:R150").PasteSpecial Paste:=xlPasteValues
Sheets("Mastertabelle").Range("w6:w400").Copy
Sheets("SI").Range("s41:s150").PasteSpecial Paste:=xlPasteValues
End If
Next i
End With
Das funktioniert auch, ist aber sehr langsam.
Lässt sich das auch eleganter, bzw. schneller lösen?
Vielen Dank schon jetzt für eure Hilfe,
Nicole

29
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA kopieren wenn
25.02.2021 17:38:50
onur
Wozu DAS hier: 
For i = 6 To 400

, wenn du sowieso immer nur den gleichen Bereich kopierst?
AW: VBA kopieren wenn
25.02.2021 20:00:04
Nicole
Sorry Onur, wenn ich deine Frage noch nicht beantwortet habe.
Ich will ja gar nicht immer den gleichen Bereich kopieren. Ich will AUS dem gleichen Bereich kopieren, aber nur wenn in der Spalte A z.B. "DD" steht.
Ich bin wirklich Anfängerin. Kurzzeitig hat der Code funktioniert. Inzwischen nicht mehr und ich weiss nicht, was ich verändert habe.
Also brauche ich das "for i = 6 to 400" gar nicht? Kann ich es weglassen oder muss ich es durch irgendetwas ersetzen?
Danke für deine Hilfe!
Gruss, Nicole
Anzeige
AW: VBA kopieren wenn
25.02.2021 20:14:27
onur
Was dein Code momentan macht: Wenn in A6 "DD" steht werden immer die gleichen Bereiche in immer die gleichen Bereiche auf Blatt "DD" kopiert, wenn in A6 "SI" steht auf Blatt "SI". Dann wird in A7 geguckt, wenn dort "DD" steht werden schon wieder die gleichen Bereiche (wie zuvor) in immer die gleichen Bereiche (wie zuvor) auf Blatt "DD" kopiert, wenn in A7 "SI" steht auf Blatt "SI". usw usw.
Das heisst: wenn in A6 bis A400 z.B. 195 x "DD" und 200x "SI" stehen würde, wird 195x immer der gleiche Bereich auf "DD" kopiert und 200x auf "SI". Also immer wieder und wieder und wieder......
Anzeige
AW: VBA kopieren wenn
25.02.2021 20:50:04
Nicole
ok, kann ich nachvollziehen. Danke!
Aber wie geht es denn richtig? Komme nicht drauf...
Danke für deine Hilfe!£
Gruss, Nicole
AW: VBA kopieren wenn
25.02.2021 20:57:10
onur
Ich hab keine Ahnung, was du WIRKLICH mit diesem Code genau vorhattest, deswegen kann ich dir dadrauf auch keine richtige Antwort geben.
AW: VBA kopieren wenn
25.02.2021 21:00:30
Nicole
Das ist mein Plan:
Wenn auf dem Tabellenblatt "Mastertabelle" in der Spalte A "DD" steht, soll auf das Tabellenblatt "DD" kopiert werden,
Wenn auf dem Tabellenblatt "Mastertabelle" in der Spalte A "SI" steht, soll auf das Tabellenblatt "SI" kopiert werden.
Beim einfügen auf dem entsprechenden Tabellenblatt sollen nur die Werte, nicht die Formeln eingefügt werden.
Anzeige
AW: VBA kopieren wenn
25.02.2021 21:03:36
onur
"soll auf das Tabellenblatt "DD" kopiert werden" ?
Ich schrieb doch ausdrücklich: GENAU.
Was GENAU soll denn wohin GENAU kopiert werden ?
AW: VBA kopieren wenn
25.02.2021 21:11:08
Nicole
Wenn in im Tabellenblatt "Mastertabelle" in der Spalte A (ab Zeile 6 bis Zeile 400) der Wert "DD" steht,
sollen die Werte der Spalten E, G, I bis N und X dieser Zeile in das Tabellenblatt "DD" kopiert werden (nur Werte, nicht Formeln). Im Tabellenblatt "DD" sollen die Werte ab Zeile 41 in die Spalten C bis K geschrieben werden.
Wenn in im Tabellenblatt "Mastertabelle" in der Spalte A (ab Zeile 6 bis Zeile 400) der Wert "SI" steht,
sollen die Werte der Spalten E, G, I bis N und X dieser Zeile in das Tabellenblatt "SI" kopiert werden (nur Werte, nicht Formeln). Im Tabellenblatt "SI" sollen die Werte ab Zeile 41 in die Spalten C bis K geschrieben werden.
Anzeige
AW: VBA kopieren wenn
25.02.2021 21:30:00
onur 

Sub DatenKopierenALLE()
Dim i, sh, dd, si, ii
dd = 41: si = 41
With Sheets("Mastertabelle")
For i = 6 To 400
sh = .Cells(i, 1)
If sh = "DD" Then ii = dd
If sh = "SI" Then ii = si
.Range("E" & i).Copy
Sheets(sh).Range("C" & ii).PasteSpecial Paste:=xlPasteValues
.Range("G" & i & ":L" & i).Copy
Sheets(sh).Range("D" & ii).PasteSpecial Paste:=xlPasteValues
.Range("M" & i).Copy
Sheets(sh).Range("M" & ii).PasteSpecial Paste:=xlPasteValues
.Range("N" & i & ":R" & i).Copy
Sheets(sh).Range("N" & ii).PasteSpecial Paste:=xlPasteValues
.Range("W" & i).Copy
Sheets(sh).Range("S" & ii).PasteSpecial Paste:=xlPasteValues
If sh = "DD" Then dd = dd + 1
If sh = "SI" Then si = si + 1
Next i
End With
End Sub

Anzeige
AW: VBA kopieren wenn
26.02.2021 08:44:59
Nicole
Vielen lieben Dank, Onur. Das funktioniert!
Wenn ich jetzt weitere Tabellenblätter habe, die genau gleich kopiert werden müssen, kann ich das einfach ergänzen, oder?
Also bei "Dim" die Blätter ergänzen. Und beim If ebenfalls.
Wie muss ich das in der Zeile 3 ergänzen? So? dd = 41: si = 41: st = 41: sb = 41
Gruss, Nicole
AW: VBA kopieren wenn
26.02.2021 09:48:51
onur
Jo.
Und unten genauso
If sh=„DD“ then dd=dd+1 usw usw
Damit wir für jedes gerade beschriebene Blatt die aktuelle Zeile um 1 erhöht.
AW: VBA kopieren wenn
26.02.2021 10:23:40
Nicole
Super, danke!
Das Ganze ist einfach sehr sehr langsam. Schon mit nur zwei Tabellen lief der Code mehrere Minuten. Jetzt, wo ich noch weitere 4 eingefügt habe, hat sich Excel aufgehängt...
Kann man das Ganze noch vereinfachen, damit es schneller wird?
Gruss, Nicole
Anzeige
AW: VBA kopieren wenn
26.02.2021 10:25:24
onur
Wie sieht denn der Code jetzt aus?
AW: VBA kopieren wenn
26.02.2021 10:38:24
Nicole 

Sub DatenKopierenALLE()
Dim i, sh, dd, si, sb, st, le, dir, ii
dd = 41: si = 41: sb = 41: st = 41: le = 41: dir = 41:
With Sheets("Mastertabelle")
For i = 6 To 400
sh = .Cells(i, 1)
If sh = "DD" Then ii = dd
If sh = "SI" Then ii = si
If sh = "SB" Then ii = sb
If sh = "ST" Then ii = si
If sh = "LE" Then ii = le
If sh = "DIR" Then ii = dir
.Range("E" & i).Copy
Sheets(sh).Range("C" & ii).PasteSpecial Paste:=xlPasteValues
.Range("G" & i & ":L" & i).Copy
Sheets(sh).Range("D" & ii).PasteSpecial Paste:=xlPasteValues
.Range("M" & i).Copy
Sheets(sh).Range("M" & ii).PasteSpecial Paste:=xlPasteValues
.Range("N" & i & ":R" & i).Copy
Sheets(sh).Range("N" & ii).PasteSpecial Paste:=xlPasteValues
.Range("W" & i).Copy
Sheets(sh).Range("S" & ii).PasteSpecial Paste:=xlPasteValues
If sh = "DD" Then dd = dd + 1
If sh = "SI" Then si = si + 1
If sh = "SB" Then ii = sb + 1
If sh = "ST" Then ii = si + 1
If sh = "LE" Then ii = le + 1
If sh = "DIR" Then ii = dir + 1
Next i
End With
End Sub

Anzeige
AW: VBA kopieren wenn
26.02.2021 11:35:22
onur
Die letzten Zeilen mit
If sh= ....
sind murks - es wird immer die Variabe um 1 erhöht, dessen Name gleich dem Blattnamen ist, also:
If sh=„SB“ then sb= sb+1. usw usw
AW: VBA kopieren wenn
26.02.2021 11:35:23
onur
Die letzten Zeilen mit
If sh= ....
sind murks - es wird immer die Variabe um 1 erhöht, dessen Name gleich dem Blattnamen ist, also:
If sh=„SB“ then sb= sb+1. usw usw
AW: VBA kopieren wenn
01.03.2021 09:19:04
Nicole
Vielen lieben Dank, Onur!
Viel gelernt, vielen Dank für deine Geduld mit meinen Fragen.
Und sorry, dass ich mich erst jetzt wieder melde. Hatte über das Wochenende keinen Zugriff aufs Netz.
Gruss, Nicole
Gerne !
01.03.2021 09:26:07
onur
und von mir dann...
26.02.2021 12:22:37
mir
Hallo,
...auch noch ein Danke fürs Ignorieren.
Gruß Werner
Anzeige
AW: und von mir dann...
01.03.2021 09:32:07
mir
Sorry Werner, ich wollte dich nicht ignorieren. Habs schlicht erst gesehen und mich auch für deine Hilfe bedankt. Ich hatte über das Wochenende keinen Zugriff aufs Netz und bin erst heute morgen wieder online. Tut mir echt leid, wenn das bei dir falsch angekommen ist. Ich finde es super, was ihr hier alle leistet und uns Unwissende schnell und kompetent mit Hilfe zur Seite steht.
Gruss, Nicole
AW: VBA - Werte kopieren
25.02.2021 18:25:10
GerdL
Moin Nicole,
wenn dein Code "funktioniert", hast du ihn hier nicht richtig eingestellt.
Denn Werte aus 395 Zellen passen so in 110 Zellen nicht rein.
Gruß Gerd
AW: VBA - Werte kopieren
25.02.2021 19:18:41
Nicole
Hallo Gerd
Es muss ja nicht alles kopiert werden. Sondern nur, wenn die Bedingung erfüllt ist. Das ist ja dann weniger. Sorry, ich bin blutige Anfängerin.
Wie mache ich das denn am besten?
Gruss, Nicole
Anzeige
AW: VBA - Werte kopieren
25.02.2021 19:36:30
onur
Würdest du auch mal MEINE Frage beantworten?
AW: VBA - Werte kopieren
25.02.2021 19:39:59
Nicole
... aber du hast recht. Es funktioniert wirklich nicht mehr. Kurzfristig hat es das. Phuuu, mal herausfinden, was ich geändert habe. Keine Ahnung...
AW: VBA kopieren wenn
25.02.2021 21:25:41
GerdL
Hallo Nicole,
vermutlich suchst du sowas. 
Sub DatenKopierenDD()
Dim txt As String, wsZiel As Worksheet, i As Long
txt = "DD"
Set wsZiel = Worksheets(txt)
With Sheets("Mastertabelle")
For i = 6 To 400
If .Cells(i, 1) = txt Then
.Cells(i, "E").Copy
wsZiel.Cells(35 + i, "C").PasteSpecial Paste:=xlPasteValues
.Range(.Cells(i, "G"), .Cells(i, "L")).Copy
wsZiel.Cells(35 + i, "D").PasteSpecial Paste:=xlPasteValues
.Range(.Cells(i, "M"), .Cells(i, "R")).Copy
wsZiel.Cells(36 + i, "M").PasteSpecial Paste:=xlPasteValues
.Cells(i, "w").Copy
wsZiel.Cells(35 + 1, "S").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next i
End With
Set wsZiel = Nothing
End Sub

Gruß Gerd
AW: VBA kopieren wenn
26.02.2021 09:02:23
Nicole
Hallo Gerd
Ja, genau, sowas suche ich :-)
Vielen lieben Dank!
Gruss, Nicole
eine Version mit dem Autofilter
26.02.2021 10:03:43
Werner
Hallo,
Public Sub aaa()
Dim varFilter As Variant, i As Long
varFilter = Array("DD", "SI")
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
.Range("A:D,F:F,H:H,O:W").EntireColumn.Hidden = True
For i = LBound(varFilter) To UBound(varFilter)
If WorksheetFunction.CountIf(.Columns("A"), varFilter(i)) > 0 Then
.Range("A5").AutoFilter field:=1, Criteria1:=varFilter(i)
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Copy
Worksheets(CStr(varFilter(i))).Range("A41").PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats
End With
End If
Next i
.Range("A:W").EntireColumn.Hidden = False
.Range("A5").AutoFilter
End With
Application.CutCopyMode = False
End Sub
Gruß Werner
AW: eine Version mit dem Autofilter
01.03.2021 09:15:12
Nicole
Hallo Werner
Vielen lieben Dank für deine Hilfe! Wieder viel gelernt!
Gruss, Nicole
Gerne u. Danke für die Rückmeldung. o.w.T.
01.03.2021 12:56:15
Werner

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige