CopyPaste mit VBA

Hallo liebe Community,
nachdem ich mit eurer Hilfe viele Excel Probleme lösen konnte und erste (rudimentäre) VBA Erfahrungen gesammelt habe, habe ich nun ein Problem bei dem ich nicht weiter komme und eure Hilfe benötige. Deshalb wende ich mich das erste Mal direkt an euch. Ich habe folgendes Problem:
Ich habe eine Excel-Tabelle mit mehreren Blättern und in jeder sind der Aufbau und die Struktur identisch, aber jedes Blatt funktioniert wie eine Datenbank. Das bedeutet, ich weiß nur min und max Anzahl der Zellen (und den Bereich) und es können auch Leerzellen dazwischen sein. Ich möchte jetzt gerne alles in einem Tabellenblatt ohne Leerzeilen konsolidieren. Leider komme ich mit Formeln nicht weiter und habe mit VBA angefangen. Das funktioniert soweit, nur crasht mir der ganze Code wenn in der Zelle eine Formel statt einer Nummer steht.
Ich habe ein simples Beispiel angehängt mit dem Code, den ich bisher habe. Mit Spalte B funktioniert der Code einwandfrei, mit Spalte C crasht er. Könnt ihr mir helfen? https://www.herber.de/bbs/user/128459.xlsm
Vielen lieben Dank für eure Hilfe!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub Consolidate() Dim objInputWorksheet As Worksheet Dim objOutputWorksheet As Worksheet Dim lngInputRow As Long, lngOutputRow As Long With Application .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False End With lngOutputRow = 3 Set objOutputWorksheet = ThisWorkbook.Worksheets("Consolidation") With objOutputWorksheet Call .Range(.Rows(3), .Rows(.Rows.Count)).ClearContents End With For Each objInputWorksheet In ThisWorkbook.Worksheets If Not objInputWorksheet Is objOutputWorksheet Then With objInputWorksheet For lngInputRow = 3 To .Cells(.Rows.Count, 2).End(xlUp).Row If Not IsEmpty(.Cells(lngInputRow, 2).Value) Then Call .Rows(lngInputRow).Copy Call objOutputWorksheet.Cells(lngOutputRow, 1). _ PasteSpecial(Paste:=xlPasteValuesAndNumberFormats) lngOutputRow = lngOutputRow + 1 End If Next End With End If Next Set objOutputWorksheet = Nothing With Application .CutCopyMode = False .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True End With End Sub

Hallo Sascha,
teste mal:

Option Explicit

Public Sub Consolidate()

    Dim objInputWorksheet As Worksheet
    Dim objOutputWorksheet As Worksheet
    Dim lngInputRow As Long, lngOutputRow As Long
    Dim strNotCopy As String

    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    strNotCopy = ",Tabelle1,Tabelle2,Tabelle3," 'Komma vorne und hinten nicht löschen !!!
    lngOutputRow = 3
    Set objOutputWorksheet = ThisWorkbook.Worksheets("Consolidation")
    With objOutputWorksheet
        Call .Range(.Rows(3), .Rows(.Rows.Count)).ClearContents
    End With

    For Each objInputWorksheet In ThisWorkbook.Worksheets
        If InStr(1, strNotCopy, "," & objInputWorksheet.Name & ",") = 0 Then
            If objInputWorksheet.Visible = xlSheetVisible Then
                If Not objInputWorksheet Is objOutputWorksheet Then
                    With objInputWorksheet
                        For lngInputRow = 3 To .Cells(.Rows.Count, 2).End(xlUp).Row
                            If .Cells(lngInputRow, 2).Value <> vbNullString Then
                                Call .Rows(lngInputRow).Copy
                                Call objOutputWorksheet.Cells(lngOutputRow, 1). _
                                    PasteSpecial(Paste:=xlPasteValuesAndNumberFormats)
                                lngOutputRow = lngOutputRow + 1
                            End If
                        Next
                    End With
                End If
            End If
        End If
    Next

    Set objOutputWorksheet = Nothing

    With Application
        .CutCopyMode = False
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

CopyPaste mit VBA

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread