Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Inhalte aus spez. Tabellenblättern kopieren.

VBA: Inhalte aus spez. Tabellenblättern kopieren.
08.11.2017 19:07:39
Michael
Hallo,
ich habe nach langer Zeit mal wieder ein Anliegen, da ich mich VBA-technisch für mich mal wieder auf Neuland begeben habe. Ich habe folgendene Fragestellungen, bei denen ich nicht weiter weiß und mich auch googlen nicht weiterbrachte (aber vllt. war ich auch einfach zu doof):
Ich möchte mithilfe eines VBA-Programmes alle Excel-Sheets einer Arbeitsmappe (ca. 60 sheets) durchlaufen. Jedes sheet das mit "T1" anfängt soll in der Spalte AA alle Werte kopieren und diese in die erste freie Spalte A in dem Sheet "CVA Kontrahenten" hinzufügen. Leider muss ich hierbei nach dem Namen im Excelsheet (und nicht nach dem Indexnamen) gehen, da die Datei regelmäßig erweitert/verändert wird und ich das Unternehmen im Dezember verlassen werde, um mich auf meine letzten Klausuren zu fokussieren.
Anbei die Formel, die ich geschrieben habe (u.a. angelehnt an etwas, das ich von Hajo gegoogelt habe) - ich glaube, dass der Code funktioniert bis auf den Punkt, dass keine Tabelle, die mit "T1" startet, gefunden wird, ich weiß aber nicht, wie ich es anders schreiben kann, LG (PS: Ich werde hierzu noch eine 2. Fragestellung gleich posten, bei der ich leider gar nicht weiterweiß):
Option Explicit

Sub Hallo()
'Variablen für Worksheet-Selection
Dim WsTabelle As Worksheet
Dim CVA As Worksheet
'Variablen zum Kopieren werden bestimmt
Dim Ticker1 As Range
Dim Ticker2 As Range
'Variablen, um in Worksheets zu arbeiten
Dim ZeileWorksheet As Long
Dim ReiheWorksheet As Long
Dim ZeileWorksheetEnde As Long
Dim ZeileCVA As Long
Dim ReiheCVA As Long
'Grundeinstellungen für die Worksheets
ReiheWorksheet = 27
ZeileWorksheet = 13
ZeileWorksheetEnde = 13
ZeileCVA = 2
ReiheCVA = 1
Set CVA = Sheets("CVA Kontrahenten")
'Code, um Worksheets auszuwählen, die "T1" beinhalten
For Each WsTabelle In Sheets
If Left(WsTabelle.Name, 2) = "T1" Then
With WsTabelle
ZeileWorksheetEnde = ZeileWorksheet
Do Until Cells(ZeileWorksheetEnde, ReiheWorksheet) = ""
If Cells(ZeileWorksheet, ReiheWorksheet) = "" Then
ZeileWorksheetEnde = ZeileWorksheetEnde + 1
End If
Loop
ZeileWorksheetEnde = ZeileWorksheetEnde - ZeileWorksheet
Set Ticker1 = Range(Cells(ZeileWorksheet, ReiheWorksheet), Cells(ZeileWorksheetEnde,  _
ReiheWorksheet))
Ticker1.Copy
Worksheets("CVA Kontrahenten").Activate
Cells(ZeileCVA, ReiheCVA).PasteSpecial xlPasteAll
ZeileCVA = ZeileCVA + ZeileWorksheetEnde
ZeileWorksheetEnde = 0
End With
End If
Next WsTabelle
End Sub

Über Hilfe freue ich mich sehr!
LG
Michi

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

Betreff
Datum
Anwender
Anzeige
AW: VBA: Inhalte aus spez. Tabellenblättern kopieren.
08.11.2017 19:53:00
Werner
Hallo Michael,
teste:
Option Explicit
Sub Hallo()
Dim wsQuelle As Worksheet, wsZiel As Worksheet
Dim loLetzteQ As Long, loLetzteZ As Long
Set wsZiel = ThisWorkbook.Worksheets("CVA Kontrahenten")
Application.ScreenUpdating = False
For Each wsQuelle In ThisWorkbook.Worksheets
If Left(wsQuelle.Name, 2) = "T1" Then
With wsQuelle
loLetzteQ = .Cells(.Rows.Count, 1).End(xlUp).Row
loLetzteZ = wsZiel.Cells(wsZiel.Rows.Count, 1).End(xlUp).Row + 1
'Kopieren von A1 bis A letzte belegte Zeile
.Range(.Cells(1, 1), .Cells(loLetzteQ, 1)).Copy
wsZiel.Cells(loLetzteZ, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End With
End If
Next wsQuelle
Set wsZiel = Nothing
Application.ScreenUpdating = True
End Sub
Gruß Werner
Anzeige
AW: VBA: Inhalte aus spez. Tabellenblättern kopieren.
08.11.2017 22:00:47
Michael
Hallo Werner,
erstmal vielen Dank für Deine sehr schnelle Hilfe! Klappt perfekt, musste es für meine Testdatei noch ein bisschen umstellen. Krass, wie kurz man den Code schreiben konnte. Kannst Du mir denn vllt. sagen, wo ich bei mir den Fehler gehabt hatte? - wenn nicht, auch nicht wild, gucke ich es mir morgen mal an. Bin gerade mal wieder erstaunt, was man alles in so wenigen Zeilen richtig bzw. in so vielen Zeilen falsch machen kann - großes Dankeschön!!
LG
Michi
AW: VBA: Inhalte aus spez. Tabellenblättern kopieren.
08.11.2017 23:55:17
Werner
Hallo Michael,
sei mir nicht böse, aber dein Code ist ein ziemliches Durcheinander.
Nur ein paar Anmerkungen:
Du ermittelst die letzte belegte Zelle in einer Spalte über eine Schleife in der du sämtliche Zellen abklapperst, bis du auf eine leere Zelle triffst. Mach das mal bei ein paar tausend Zeilen.
Hier hängst du in einer Endlosschleife:
Do Until .Cells(ZeileWorksheetEnde, ReiheWorksheet) = ""
If .Cells(ZeileWorksheet, ReiheWorksheet) = "" Then
ZeileWorksheetEnde = ZeileWorksheetEnde + 1
End If
Loop

Die Zelle die du prüfst ist nicht leer. Somit kommst du gar nicht in den If Zweig, in dem du den Zeilenzähler erhöst. Somit prüfst du bis in alle Ewigkeit immer die gleiche Zelle.
Wenn, dann müsstest du hier
If .Cells(ZeileWorksheet, ReiheWorksheet)  "" Then

auf ungleich leer prüfen. Aber wie schon angemerkt, ermittelt man die letzte belegte Zeile am besten nicht in einer Schleife.
Gruß Werner
Anzeige
AW: VBA: Inhalte aus spez. Tabellenblättern kopieren.
09.11.2017 16:49:22
Michael
Hallo Werner,
ich bin dir da total dankbar, bin nur ein kleiner BWLer, der so 5-6 Stunden die Woche etwas VBA-technisch für seine Kollegen programmiert, damit wir weniger manuell machen müssen. Bin dir da total dankbar für die Hilfe, versuche das so ab jetzt häufiger anzuwenden.
LG
Michi
Gerne u.Danke für die Rückmeldung. o.w.T.
09.11.2017 17:15:02
Werner

352 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige