Excel Blätter beim Makrolauf aktivieren
22.03.2015 13:03:41
Joe
Ich frage mich ob mir jemand mit dem Makro hier helfen kann. Ich habe eine Ziel-Datei in die ich von mehreren anderen Excel-Dateien bestimmte Werte importieren möchte und wenn alles geglückt ist, die Source-Dateien wieder schliesse. Leider hänge ich bei der Zeile 175
Val(3) = Left(Val(3), InStr(Val(3), ".") - 1)
Offenbar kann ich nicht alle Source-Dateien im Hintergrund aktivieren, so dass die Daten von den geöffneten Excel-Dateien geholt werden können. Wenn ich nur einen oder zwei Source-Dateien öffne und sie reinklicke, klappt es zwar manchmal aber mein Ziel wäre es die Werte von mindestens 5 Excel-Dateien zu holen.
Ich bin leider ein Amateur in Sachen Makro-Schreiben, hätte evtl. jemand einen Tipp für mich ? Hab schon einen schweren Kopf von diesem Code. Wäre für jede Hilfe (und Korrektur-Vorschläge) dankbar.
Sub Get_Data()
' Dim Spalte, Zeile As Integer
' Dim Stadt, MonatName As String
' Dim wkb As Workbook
' For Each wkb In Workbooks
' On Error Resume Next
Dim StrActName As String
Dim Val
Dim StrOrt, StrDatum, StrCol, StrRow, StrCell1, StrCell2, StrCell3 As String
Dim StrTemp1, StrTemp2, StrTemp3 As Double
Application.WindowState = xlNormal
StrActName = ActiveWorkbook.Name
Val = ReturnStrArray(StrActName)
StrOrt = Val(0)
Windows(StrActName).Activate
'Erster Wert======================================================
Range("H2").Select
Application.CutCopyMode = False
Selection.Copy
StrTemp1 = Range("H2").Value2
Windows("Target_File.xlsm").Activate
StrDatum = "01." & Val(3) & "." & Val(2)
'MsgBox StrDatum
'?row?
StrRow = Lokalisieren(CStr(StrDatum))
If CStr(StrOrt) = CStr("Source_Name1") Then
StrCol = "C"
End If
If CStr(StrOrt) = CStr("Source_Name2") Then
StrCol = "D"
End If
If CStr(StrOrt) = CStr("Source_Name3") Then
StrCol = "E"
End If
If CStr(StrOrt) = CStr("Source_Name4") Then
StrCol = "F"
End If
If CStr(StrOrt) = CStr("Source_Name5") Then
StrCol = "G"
End If
StrCell1 = StrCol & StrRow
Range(StrCell1).Select
Range(StrCell1).Value = StrTemp1
'Range("C112").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
'Zweiter Wert======================================================
Application.WindowState = xlNormal
' Windows("Source_Name_2014_10.xls").Activate
Windows(StrActName).Activate
Range("I2").Select
Application.CutCopyMode = False
Selection.Copy
StrTemp2 = Range("I2").Value2
Windows("Target_File.xlsm").Activate
If CStr(StrOrt) = CStr("Source_Name1") Then
StrCol = "Z"
End If
If CStr(StrOrt) = CStr("Source_Name2") Then
StrCol = "AA"
End If
If CStr(StrOrt) = CStr("Source_Name3") Then
StrCol = "AB"
End If
If CStr(StrOrt) = CStr("Source_Name4") Then
StrCol = "AC"
End If
If CStr(StrOrt) = CStr("Source_Name5") Then
StrCol = "AD"
End If
StrCell2 = StrCol & StrRow
Range(StrCell2).Select
Range(StrCell2).Value = StrTemp2
'Range("Z112").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Dritter Wert======================================================
Application.WindowState = xlNormal
' Windows("Source_Name_2014_10.xls").Activate
Windows(StrActName).Activate
Range("J2").Select
Application.CutCopyMode = False
Selection.Copy
StrTemp3 = Range("J2").Value2
Windows("Target_File.xlsm").Activate
If CStr(StrOrt) = CStr("Source_Name1") Then
Sheets("ESBK_15").Select
StrCol = "AW"
End If
If CStr(StrOrt) = CStr("Source_Name2") Then
StrCol = "AX"
End If
If CStr(StrOrt) = CStr("Source_Name3") Then
StrCol = "AY"
End If
If CStr(StrOrt) = CStr("Source_Name4") Then
StrCol = "AZ"
End If
If CStr(StrOrt) = CStr("Source_Name5") Then
StrCol = "BA"
End If
StrCell3 = StrCol & StrRow
Range(StrCell3).Select
Range(StrCell3).Value = StrTemp3
' Range("AW112").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim Wkb As Workbook
For Each Wkb In Workbooks
If Wkb.Name ThisWorkbook.Name Then
Wkb.Close SaveChanges:=True
End If
Next Wkb
End Sub
Function ReturnStrArray(Str As String) As String()
'Dim Dstr(0 To 3) As String
Dim Val, n
'Str = "Source_Name_2014_10.xlsx"
Val = Split(Str, "_")
For n = LBound(Val) To UBound(Val)
Next
Val(3) = Left(Val(3), InStr(Val(3), ".") - 1)
ReturnStrArray = Val
MsgBox Val(0)
MsgBox Val(1)
MsgBox Val(2)
MsgBox Val(3)
End Function
Sub Exa1()
Dim Str As String
Str = "Source_Name_2014_10.xls"
ReturnStrArray (Str)
End Sub
Function Lokalisieren(id As String) As String
Dim lastrow As Long, r As Long
Dim Lokal As String
'Dim id As String
'id = InputBox(?)
lastrow = ActiveSheet.UsedRange.Rows.Count
For r = 1 To lastrow Step 1
If Cells(r, 1) = id Then
Lokal = CStr(r)
'MsgBox "?!" & r
Cells(r, 1).Select
Cells(r, 1).Font.Bold = True
Exit For
End If
Next r
Lokalisieren = Lokal
End
Function
Anzeige