Hallo,

eigentlich müsste das doch auch relativ einfach mit Formeln, also ohne VBA gehen. => würde ich mal in Erwägung ziehen.

Was mir direkt auffällt: wenn du die Workbook.SaveAs - Methode benutzt, solltest du immer auch das Fileformat mit angeben:

If SaveDummy <> False Then ActiveWorkbook.SaveAs SaveDummy, fileformat:=-4143   ' für eine *.xls-Datei

oder

If SaveDummy <> False Then ActiveWorkbook.SaveAs SaveDummy, fileformat:=52   ' für eine *.xlsm-Datei

Um das ganze etwas zu vereinfachen und den Programmieraufwand zu verringern würde ich eine Vorlagendatei erstellen, die bereits alle Diagramme fertig formatiert beinhaltet. Dann würde sich nämlich alles auf

=> Vorlagendatei öffnen

=> Datendateien öffnen

=> Daten aus den Datendateien in die Vorlage kopieren

=> Datendateien schließen

=> Vorlage speichern

reduzieren. Das würde ich alles in einem einzigen Makro machen, dann wird es nämlich deutlich einfacher.

In einem if .. then ... else ... end if - Konstrukt wird immer nur der Code zwischen then und else oder der zwischen else und end if ausgeführt:

sub IfBeispielAusprobieren()

if second(time) mod 2 = 0 then
   msgbox "diese Box erscheint, weil die If-Bedingung wahr ist"
else
   msgbox "diese Box erscheint, weil die If-Bedingung nicht wahr ist."
end if

end sub

Wenn du obiges Makro ausprobierst, siehst du, dass immer nur eine MsgBox erscheint. Deine Goto-Anweisungen sind also völlig überflüssig.

Der Code könnte um bei deinem Konstrukt zu bleiben in etwa so aussehen:

Sub DatenVergleich()
    dim wbDiagramm as workbook
    dim wsZiel as worksheet
    dim wsQuelle as worksheet
    dim wsAufruf as worksheet

    'aktuelles Tabellenblatt merken
    set wsAufruf = activesheet

    'Vorlagendatei öffnen
    set wbDiagramm = workbooks.add("C:\pfad\Vorlagendatei.xltx")
    set wsziel = wbdiagramm.worksheets(1)                           'Tabellenblatt, in das alle Daten kopiert werden
 
    'Raumschallmessung Datei 1
    If Range("B13").Value = "" Then
        'mach nichts
    Else
        Workbooks.Open Filename:=wsAufruf.Range("B13")              'Datendatei öffnen
        set wsquelle = activeworkbook.worksheets("dB(A)")           'Tabellenblatt in dem die Daten stehen
        wsZiel.range("A2:B201").value = wsQuelle.Range("D12:E211")  'Daten Mikrofon 1 kopieren
        wsziel.range("C2:C201").value = wsQuelle.Range("J12:J211")  'Daten Mikrofon 2 kopieren
        '...                                                        'Daten Mikrofon 3 kopieren

        wsQuelle.parent.close savechanges:=false                    'Datendatei schließen
    End If
 
    'Raumschallmessung Datei 2
    If Range("B15").Value = "" Then
        'mach nichts
    Else
        Workbooks.Open Filename:=wsAufruf.Range("B15")              'Datendatei öffnen
        set wsquelle = activeworkbook.worksheets("dB(A)")           'Tabellenblatt in dem die Daten stehen
        wsZiel.range("K2:L201").value = wsQuelle.Range("D12:E211")  'Daten Mikrofon 1 kopieren
        wsziel.range("M2:M201").value = wsQuelle.Range("J12:J211")  'Daten Mikrofon 2 kopieren
        '...                                                        'Daten Mikrofon 3 kopieren

        wsQuelle.parent.close savechanges:=false                    'Datendatei schließen
    End If
     
    'Raumschallmessung Datei 3
    If Range("B17").Value = "" Then
        'mach nichts
    Else
        Workbooks.Open Filename:=wsAufruf.Range("B17")              'Datendatei öffnen
        set wsquelle = activeworkbook.worksheets("dB(A)")           'Tabellenblatt in dem die Daten stehen
        wsZiel.range("U2:V201").value = wsQuelle.Range("D12:E211")  'Daten Mikrofon 1 kopieren
        wsziel.range("W2:W201").value = wsQuelle.Range("J12:J211")  'Daten Mikrofon 2 kopieren
        '...                                                        'Daten Mikrofon 3 kopieren

        wsQuelle.parent.close savechanges:=false                    'Datendatei schließen
    End If
     
     'Raumschallmessung Datei 4
    If Range("B19").Value = "" Then
        'mach nichts
    Else
        Workbooks.Open Filename:=wsAufruf.Range("B19")              'Datendatei öffnen
        set wsquelle = activeworkbook.worksheets("dB(A)")           'Tabellenblatt in dem die Daten stehen
        wsZiel.range("AE2:AF201").value = wsQuelle.Range("D12:E211") 'Daten Mikrofon 1 kopieren
        wsziel.range("AG2:AG201").value = wsQuelle.Range("J12:J211") 'Daten Mikrofon 2 kopieren
        '...                                                        'Daten Mikrofon 3 kopieren

        wsQuelle.parent.close savechanges:=false                    'Datendatei schließen
    End If
 
    'Raumschallmessung Datei 5
    If Range("B21").Value = "" Then
        'mach nichts
    Else
        Workbooks.Open Filename:=wsAufruf.Range("B21")              'Datendatei öffnen
        set wsquelle = activeworkbook.worksheets("dB(A)")           'Tabellenblatt in dem die Daten stehen
        wsZiel.range("AO:AP201").value = wsQuelle.Range("D12:E211")  'Daten Mikrofon 1 kopieren
        wsziel.range("AQ2:AQ201").value = wsQuelle.Range("J12:J211") 'Daten Mikrofon 2 kopieren
        '...                                                        'Daten Mikrofon 3 kopieren

        wsQuelle.parent.close savechanges:=false                    'Datendatei schließen
    End If

    'hier könnte jetzt das Speichern der neuen Datei kommen:
    'wbDiagramm.SaveAs "c:\....\...\...xls", fileformat:=-4143 
 
End Sub

Der Code ist nicht getestet. Selbstverständlich muss jeder Bereich angepasst werden und auch die Dateipfade / Dateinamen.