Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 17:19:09
Formel mit Index-Funktion
24.04.2024 16:19:42
SummeWenn / SummeWenns mit Bedingung wenn kleiner als dann
24.04.2024 14:48:50
"Eingabefeld" zwischen zwei Zeilen geht nicht weg.
24.04.2024 14:40:10
Zeilenumbrüche in Textbox zählen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1464to1468
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
1464to1468
1464to1468
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code ändern

Code ändern
16.12.2015 09:08:38
Thomas
Hallo zusammen,
mit diesem Code werden alle KW49,KW50,KW51,KW52 in das Tabellenblatt Zusammenfassung zusammengeführt. 
Sub zusammenfassung()
Dim vntQUELLE As Variant
Dim wsZiel As Worksheet
Dim intINDEX As Integer
vntQUELLE = Array("KW49", "KW50", "KW51", "KW52")
Set wsZiel = Worksheets("Zusammenfassung")
For intINDEX = LBound(vntQUELLE) To UBound(vntQUELLE)
With Worksheets(vntQUELLE(intINDEX))
.Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1)).Copy
If IsEmpty(wsZiel.Cells(2, 1)) Then
wsZiel.Cells(2, 1).PasteSpecial xlPasteAll
Else
wsZiel.Cells(wsZiel.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
End If
Application.CutCopyMode = False
End With
Next
End Sub

kann man diesen Code ändern, das er einfach alle Tabellenblätter wo KW zusammenführt?
Denn manchmal gibt es keine z.B. KW50 und dann kommt fehlermeldung
Hoffe ihr könnt mir helfen.
Danke
LB Thomas

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code ändern
16.12.2015 09:19:31
hary
Moin
Probier mal. 
Dim wsZiel As Worksheet
Dim intINDEX As Long
Set wsZiel = Worksheets("Zusammenfassung")
For intINDEX = 1 To Worksheets.Count
With Worksheets(intINDEX)
If Ucsae(Left(.Name, 2)) = "KW" Then
.Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1)).Copy
If IsEmpty(wsZiel.Cells(2, 1)) Then
wsZiel.Cells(2, 1).PasteSpecial xlPasteAll
Else
wsZiel.Cells(wsZiel.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
End If
End If
Application.CutCopyMode = False
End With
Next

gruss hary

AW: Code ändern
16.12.2015 09:53:01
Tim
Hallo,
Danke erstmal
leider kommt ein Fehler: 
Sub zusammenfassung()
Dim wsZiel As Worksheet
Dim intINDEX As Long
Set wsZiel = Worksheets("Zusammenfassung")
For intINDEX = 1 To Worksheets.Count
With Worksheets(intINDEX)
If Ucsae(Left(.Name, 2)) = "KW" Then
.Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1)).Copy
If IsEmpty(wsZiel.Cells(2, 1)) Then
wsZiel.Cells(2, 1).PasteSpecial xlPasteAll
Else
wsZiel.Cells(wsZiel.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
End If
End If
Application.CutCopyMode = False
End With
Next
End Sub
Suboder 

Function nicht definiert
If Ucsae wird markiert
Anzeige
AW: Code ändern
16.12.2015 09:53:14
Thomas
Hallo,
Danke erstmal
leider kommt ein Fehler: 
Sub zusammenfassung()
Dim wsZiel As Worksheet
Dim intINDEX As Long
Set wsZiel = Worksheets("Zusammenfassung")
For intINDEX = 1 To Worksheets.Count
With Worksheets(intINDEX)
If Ucsae(Left(.Name, 2)) = "KW" Then
.Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1)).Copy
If IsEmpty(wsZiel.Cells(2, 1)) Then
wsZiel.Cells(2, 1).PasteSpecial xlPasteAll
Else
wsZiel.Cells(wsZiel.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
End If
End If
Application.CutCopyMode = False
End With
Next
End Sub
Suboder 

Function nicht definiert
If Ucsae wird markiert
Anzeige
AW: sry, Schreibfehler
16.12.2015 10:02:03
hary
Moin
uss natuerlich
statt Ucsae
UCase
heissen.
gruss hary

AW: sry, Schreibfehler
16.12.2015 10:51:01
Thomas
Hallo klappt super,
aber es nimmt jeweils von jeder KW die erste Zeile mit. Er soll immer erst ab der Zweiten Zeile kopieren und zusammenfassen.
Danke Dir
Thomas

AW: sry, Schreibfehler
16.12.2015 11:11:08
hary
Moin
Ist SpaltA nicht vollstaendig belegt?
Evtl.so. 
.Range(.Cells(2, 1), .Cells(.Rows.Count, 2).End(xlUp).Offset(0, 1)).Copy

oder meinst du etws anderes?
gruss hary

AW:ohne Offset
16.12.2015 11:13:06
hary
Moin
Nimm diese Zeile. 
.Range(.Cells(2, 1), .Cells(.Rows.Count, 2).End(xlUp)).Copy

gruss hary

Anzeige
AW: AW:ohne Offset
16.12.2015 14:12:58
Thomas
Hallo Hary,
geht leider immer noch nicht.
In allen Tabellenblätter ( von KW1 bis KW53) steht immer nur in der ersten Zeile die Bezeichnung ( Vorbereitung)
Die Daten folgen erst später ( z.b.KW 2 in der KW2 usw.)
Jetzt möchte ich das ich nicht alle Tabellenblätter aufmachen und schauen ob noch Daten vorhanden sind.
Deswegen müsste er immer die zweite Zeile nehmen und die Daten ins Tabellenblatt zusammenfassung untereinander einfügen.
Danke für deine Hilfe erstmal
Thomas

AW:Bsp.-Mappe
17.12.2015 05:54:35
hary
Moin Thomas
Lad mal hier mal eine Bsp.-Mappe hoch mit dem Blatt und einem KW-Blatt. Damit ich sehe wie es aussieht/was du meinst.
gruss hary

Anzeige
AW: AW:Bsp.-Mappe
17.12.2015 18:45:32
Thomas
Hallo Hary,
die original Datei sind von der KW1 bis KW53 vorhanden. Leider konnte ichnicht die original Datei hochladen da die zu groß ist.
Aber wenn ich den Code laufen lasse kommt immer die erste Zeile.
Ich möchte eigentlich alle Daten von A2 bis AF dort drin haben.
https://www.herber.de/bbs/user/102326.xlsm
Danke für deine Unterstützung.
Gruß Thomas

AW: sollte klappen
18.12.2015 09:39:21
hary
Moin Thomas
So sollte es klappen. Es werden SpalteA bis SpalteE kopiert. 
Sub zusammenfassung()
Dim wsZiel As Worksheet
Dim intINDEX As Long
Set wsZiel = Worksheets("Zusammenfassung")
Application.ScreenUpdating = False '---Bildschirmaktuellisierung aus
wsZiel.Cells(2, 1).Resize(wsZiel.Cells(Rows.Count, 1).End(xlUp).Row, 5).Clear '---alles  _
loeschen
For intINDEX = 1 To Worksheets.Count
With Worksheets(intINDEX)
If UCase(Left(.Name, 2)) = "KW" Then '---wenn B.-Name mit KW anfaengt
If .Cells(2, 1)  "" Then '---wenn A2 in Blatt(KW) belegt
.Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp), 5).Copy wsZiel.Cells(wsZiel.Rows. _
Count, 1).End(xlUp).Offset(1, 0)
End If
End If
End With
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True '---Bildschirmaktuellisierung ein
End Sub

gruss hary

Anzeige
AW: sollte klappen
19.12.2015 17:42:45
Thomas
Hallo Hary, klappt alles Super :-)
Was bedeutet bei deinen Code Bildschirmaktualisierung aus und unten wieder ein ?
Danke Dir

AW: Bildschirmaktuellisierung
20.12.2015 08:15:56
hary
Moin Thomas
"Bildschirmaktuellisierung" hab ich zur Vorsicht eingebaut.
Bedeutet: Der Bildschirm wird mit False eingefroren, also es sind keine Aenderungen sichtbar.Obwohl der Code aenderungen in der Mappe/Tabelle vornimmt.
Erst mit True wird das Bildschirmbild aktuellisiert.
Wird eingebaut um Bildschirm flackern(waehrend der Code arbeitet) zu unterdruecken. Ob es hier in Code noetig ist hab ich nicht getestet. Auf alle Faelle muss, wenn ausgeschaltet, auch wieder eingeschaltet werden.
Sonst bleibt das Bildschirmbild wie es ist trotz Aenderungen.
Kannst ja mal die beiden Zeilen rausnehmen und schauen ob der Bildschirm flackert.
gruss hary
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige