AW: Info an dich Romina
20.03.2013 11:52:03
Klaus
Hi,
das sollte es tuen. Ich habe mich akribisch an deine Vorgaben (Tabellennamen, Spalten) aus dem Beitrag gehalten. Wenn in deiner Masterdatei irgendwas anders heisst, musst du entsprechend umbenennen. Ich gehe davon aus, dass in Zelle A1 (also in Zeile 1) niemals eine Summe stehen wird!
Sub CheckeSummeInExternemFIle()
Dim wkbOld As Workbook
Dim wkbNew As Workbook
Dim lRow As Long
Dim lWert As Double
'aktuelle Datei merken, neue Datei öffnen
Set wkbOld = ActiveWorkbook
Call FileCheckOpen("C:\TestTmp", "Datei1.xlsm") 'ANPASSEN
'neue Datei merken
Set wkbNew = ActiveWorkbook
Sheets("Tabelle1").Activate 'ANPASSEN
With ActiveSheet
'letzte Zeile
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'Autofilter nutzen, um das Wort "Summe" zu finden
'geht VIEL schneller als eine Schleife über jede Zelle!
If .AutoFilterMode Then .Cells.AutoFilter
.Range("A1").Value = "TEMP" 'Autofilter braucht eine gefüllte erste Zelle
.Range(.Cells(1, 1), .Cells(lRow, 1)).AutoFilter
.Range("A1").AutoFilter Field:=1, Criteria1:="=Summe"
'Summe ermitteln, falls es eine gibt (sonst null)
lWert = Application.WorksheetFunction.Sum(.Range("B1:CP" & lRow).SpecialCells( _
xlCellTypeVisible))
End With
'Datei schließen ohne speichern
wkbNew.Close False
'alte Datei aktivieren
wkbOld.Activate
Sheets("Tabelle2").Activate
With ActiveSheet
'"Beispiel+Tabelle2" in der nächsten freien Zelle der Spalte J ausgegeben werden
lRow = .Cells(.Rows.Count, 10).End(xlUp).Row + 1
.Range("J" & lRow).Value = lWert
End With
End Sub
'*********************************************************************************************** _
'* Module to open needed files. Checks if Files are open or not.
'* If file is already open, do nothing - else open it
'* stolen from: https://www.herber.de/mailing/Pruefen_ob_Arbeitsmappe_geoeffnet_und_wenn_nein_oeffnen.htm
'* modified by Klaus MvdT / 16.NOV.2012
'*********************************************************************************************** _
'Example:
'Call FileCheckOpen("C:\TMP", "Filename.xls")
'path and filename can be RANGE from excelsheet
Sub FileCheckOpen(sPath As String, sFile As String)
sPath = sPath & "/" & sFile
If WkbExists(sFile) = False Then
If Dir(sPath) = "" Then
MsgBox "File " & sPath & " not found!"
Else
Workbooks.Open sPath, UpdateLinks:=False
End If
Else
Workbooks(sFile).Activate
End If
End Sub
Private Function WkbExists(sFile As String) As Boolean
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(sFile)
If Not wkb Is Nothing Then
WkbExists = True
End If
On Error GoTo 0
End Function
Grüße,
Klaus M.vdT.