kopieren von Spalten nach name
15.06.2015 17:54:30
Spalten
ich hab mal wieder ein Problem, der Code unter sucht in einer
geschlossenen Tabelle, so weit so gut. Die geschlossene Datei hat in Spalte E2-E300
verschiedene werte stehen z.B. Ship O1,Ship O2 usw. Ich möchte jetzt nur die Namen, die in Spalte A2-A300 stehen und in Spalte E2-E300 Ship O1 steht in meine Tabelle kopieren. In der zweiten For schleife hab ich schon mal probiert, bekomme es aber einfach nicht hin.
Vielen Dank schon mal
chito
Option Explicit
Function GetValue(path, file, sheet, ref)
Dim arg As String
If Right(path, 1) "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , _
xlUp)
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub name6()
Dim name1 As String
Dim a As String
Dim b As String
Dim c As String
Dim badge As Long
Dim code As Long
Dim schicht As String
Dim w As Range
Dim name2 As String
Dim Zelle As Range, wks As Worksheet, Bereich As String, lloRow As Long
name1 = 4
schicht = 4
badge = 14
code = 14
name2 = 4
Set wks = ActiveSheet
Range("V1") = "Schichttyp / BadgeID / Login und Namen werden aus der AWH geholt"
a = ThisWorkbook.path 'beide Dateien müssen im selben Verzeichnis gespeichert sein
b = "Statistik 2015-06-11.xlsx" 'Name der geschlossenen Datei; ändern, wenn erforderlich
c = "Statistik 11.06." 'Blattname in geschl. Datei; ändern, wenn erforderlich
For Each Zelle In wks.Range("A3:A95")
Range("B" & schicht).Value = GetValue(a, b, c, Zelle.Address)
schicht = schicht + 1
Next Zelle
If w = "Ship O1" Then
For Each w In wks.Range("E2:E95")
Range("A" & name1).Value = GetValue(a, b, c, Zelle.Address)
name1 = name1 + 1
Next w
End If
End Sub