ich habe noch nie was mit VBA gemacht und sitze jetzt schon zimlich lang dran. Könnt ihr mir vielleicht helfen woran es liegt.
Mein Problem:
Ich habe mehrere Arbeitsmappen in den aber der Zeile 7 von A bis F eine Aufgabenliste von jedem Mitarbeiter steht. Diese Aufgabenlisten möchte ich in eine andere Arbeitsmappe (Aufgabenliste_Team.xls ) reinkopieren. Der Kopiervorgang soll mit dem Klicken auf den Button Auffüllen in der Arbeitsmappe Aufgaben_Team.xls angestoßen werden. Die Teamnamen stehen in dem Sheet Team in der Arbeitsmappe Aufgabenliste_Team.
Mein derzeitiger fehlerhafte Code sieht so aus:
Option Explicit
Private Sub btauffuellen_Click()
Dim zielDatei As Workbook
Dim quellDatei As Workbook
Dim dateiName As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim aufgabenVorhanden As Boolean
Dim aufgaben As Variant
Dim aufgabenPunkte() As Variant
Set zielDatei = ActiveWorkbook
'Abschalten der Warnmeldungen und der Screenaktualisierung
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Bereinigen der Zieldatei
zielDatei.Sheets("Aufgaben").Select
ActiveSheet.Range("A7:I200").Delete
'Auslesen der Dateinamen, die ausgelesen werden sollen
Sheets("Team").Select
Sheets("Team").Range("A1").Select
Do Until ActiveCell.Value = ""
dateiName = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
If Dir(ThisWorkbook.Path & "\aufgaben_" & dateiName & ".xls") = "" Then
MsgBox ("Die Datei & aufgaben_ & dateiName & .xls liegt nicht in dem gleichen Verzeichnis wie die Zieldatei"), vbCritical, "Datenbank nicht gefunden!"
Exit Sub
Else
Workbooks.Open Filename:=ThisWorkbook.Path & "\aufgaben_" & dateiName & ".xls"
End If
'Aktivierung der Quelldatei
Set quellDatei = ActiveWorkbook
ActiveSheet.Range("F6").Select
aufgabenVorhanden = False
'Wenn Aufgaben vorhanden sind
If ActiveCell <> "" Then
aufgabenVorhanden = True
Do Until ActiveCell = "" And i > 30
aufgabenPunkte(i, k) = ActiveCell.Value
i = 5
i = i + 1
For k = 1 To 5 Step 1
k = k + 1
Next k
Loop
End If
'Nach dem Auslesen der Aufgaben
quellDatei.Close
j = 0
zielDatei.Sheets("Aufgaben").Select
If aufgabenVorhanden Then
ActiveCell.Value = dateiName
ActiveCell.Offset(2, 0).Select
Do Until j >= i
Loop
End If
Loop
zielDatei.Sheets("Aufgaben").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub