Datenübertragung mit Zellenbereichen
12.01.2015 10:22:12
Patrick Prautsch
Hallo Zusammen,
ich habe zZ ein Problem bei einer Datenübermittlung zwischen Mehreren Excel Tabellen.
Folgende Situation: Ich habe ein Excel Formular das sich aus mehrere anderen Excel Tabellen Quoten ziehen soll. Die Abfrage funktioniert nicht mehr und ich komme leider nicht weiter.
Dazu muss ich sagen das mein leider aus der Gruppe ausgeschiedener Kollege diese Funktion geschrieben hat.
hier einmal der VBA Code der hinter dem Aktualisierungsbutton liegt:
Ab dem Fett makiertem select meckert der debugger...hat jmd eine Idee?
Vielen Vielen Dank im Voraus
Sub aktualisieren()
Dim daten(1 To 14, 1 To 2)
Dim daten_neu(1 To 9)
week = Sheets("Auflaufend").Cells(7, 13)
If week < 10 Then
weeks = "0" & week
Else
weeks = week
End If
wbname = weeks & " - Weiterleitungsreport_KW" & weeks & ".xls"
pfad = "\\Pfad1\"
'wbname = "wlkw5.xls"
'pfad = "C:\AZ_DATEN\"
Workbooks.Open Filename:=pfad & wbname
With Workbooks(wbname).ActiveSheet
'Stop
'aktuell:
For k = 1 To 7
daten(k, 1) = CLng(.Cells(k + 1, 2))
daten(k, 2) = CLng(.Cells(k + 1, 3))
Next k
'auflaufend:
'For k = 8 To 14
' daten(k, 1) = CLng(.Cells(k + 8, 2))
' daten(k, 2) = CLng(.Cells(k + 8, 3))
'Next k
End With
Workbooks(wbname).Close False
With ThisWorkbook.Sheets(week + 1)
.Select For k = 1 To 7
.Cells(k + 6, 3) = daten(k, 1)
.Cells(k + 6, 5) = daten(k, 2)
daten_neu(k) = .Cells(k + 6, 6)
Next k
daten_neu(8) = .Cells(15, 6)
daten_neu(9) = 1 - daten_neu(8)
End With
'With ThisWorkbook.Sheets(1)
' .Select
' For k = 7 To 14
' .Cells(k, 3) = daten(k, 1)
' .Cells(k, 5) = daten(k, 2)
' Next k
'End With
With ThisWorkbook.Sheets(Sheets.Count())
.Select
For k = 1 To 8
.Cells(k + 1, week + 1) = daten_neu(k)
Next k
End With
Sheets(1).Select
Dim sum(1 To 7)
Dim sum2(1 To 7)
'Stop
For k = 2 To Sheets.Count()
For i = 1 To 7
sum(i) = sum(i) + Sheets(k).Cells(6 + i, 3)
sum2(i) = sum2(i) + Sheets(k).Cells(6 + i, 5)
Next i
Next k
'Stop
Sheets(1).Select
For i = 1 To 7
Cells(6 + i, 3) = sum(i)
Cells(6 + i, 5) = sum2(i)
Next i
End Sub