Live-Forum - Die aktuellen Beiträge
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
Inhaltsverzeichnis

Code ändern

Code ändern
16.12.2015 09:08:36
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Doppelt owT
16.12.2015 10:06:58
Bernd

AW: Code ändern
16.12.2015 10:28:15
ransi
Hallo Bernd,
Versuch mal so:
(ungetestet)
For Each ws In Worksheets
    If Left(ws.Name, 2) Like "KW" Then
        With ws
            .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1)).Copy
            If IsEmpty(wsZiel.Cells(2, 1)) Then
                .
                .
                .
            End If
        End With
    End If
Next

ransi

Anzeige
AW: Code ändern
16.12.2015 10:28:32
ransi
Hallo Bernd,
Versuch mal so:
(ungetestet)
For Each ws In Worksheets
    If Left(ws.Name, 2) Like "KW" Then
        With ws
            .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1)).Copy
            If IsEmpty(wsZiel.Cells(2, 1)) Then
                .
                .
                .
            End If
        End With
    End If
Next

ransi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige