Überlauf beim Kopieren von Ranges
24.10.2008 12:02:57
Ranges
ich bin neu hier im Forum und schreibe per VBA an einem Makro, um csv.Files aus vordefinierten Ordnern und nach Sparten geordnet in eine Übersicht zu schreiben und ordentlich zu formatieren. Hierzu kopiere ich sie in einen Arbeitsbereich und lege pro Sparte individuell fest, welche Werte wo in meine Übersicht geschrieben werden. Da die Größe (sprich Zeilenanzahl) der csv-Dateien aber individuell ist, habe ich zwei Variablen deklariert, welche die Größe festlegen.
Der Übertrag funktioniert auch wunderbar für die Sparte "KAP", beim zweiten Durchlauf der Schleife, welche die ElseIf-Verzweigung aufruft, kommt es aber beim Übertrag von "LVR" zu einem Überlauf, welchen ich mir nicht erklären kann. Ich hoffe Ihr könnt mir da weiterhelfen.
Hier der Code:
Modul2:
Sub InitSparte()
cetofi = 7
End Sub
Sub SparteLVR()
Sheets("Arbeitsbereich").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;R:\AMS-Export\LVR\" & VN & ".csv", Destination:=Range("A1"))
.Name = VN
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
lafice = Cells(Rows.Count, 1).End(xlUp).Row
End Sub
Sub SparteKAP()
Sheets("Arbeitsbereich").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;R:\AMS-Export\KAP\" & VN & ".csv", Destination:=Range("A1"))
.Name = VN
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
lafice = Cells(Rows.Count, 1).End(xlUp).Row
End Sub
Modul4:
Public VN As String
Public cetofi As Integer 'cetofi = Cell to Fill /Zeilennummer für Übertrag
Public lafice As Integer 'lafice = Last filled Cell /Zeilennummer der letzten befüllten Zelle im Arbeitsbereich
Dim kategorie As String
Dim var As String
Dim sparten(16) As String
Public usra1 As Variant 'Das linke obere Ende des befüllten Zellbereichs finden/usra = Used Range
Public usra2 As Variant 'Das rechte untere Ende des befüllten Zellbereichs finden
Sub import(ByVal kat As String, ByVal ip As String)
Sheets("Leben & Rente").Select
'Tabellenblatt formatieren und einrichten
FormLuR
If kat = "PRV" Then
MsgBox kat
ElseIf kat = "KAP" Then
'Werte in den Arbeitsbereich übertragen
SparteKAP
usra1 = "A" & cetofi
usra2 = "O" & lafice + 6
MsgBox usra1
MsgBox usra2
Sheets("Leben & Rente").Range("A" & cetofi & ":G" & (cetofi + lafice) - 1).Value = _
Sheets("Arbeitsbereich").Range("A1:G" & lafice).Value
Sheets("Leben & Rente").Range("I" & cetofi & ":I" & (cetofi + lafice) - 1).Value = _
Sheets("Arbeitsbereich").Range("H1:H" & lafice).Value
'Arbeitsbereich leeren
Clearing
'Allgemeine Formatierung
Sheets("Leben & Rente").Activate
FormData
'Spalten in richtiges Format bringen
FormColumn
'Zahlweise formatieren
FormZW
cetofi = cetofi + lafice
ElseIf kat = "INV" Then
MsgBox kat
ElseIf kat = "LVR" Then
MsgBox kat
MsgBox VN
'Werte in den Arbeitsbereich übertragen
SparteLVR
usra1 = "A" & cetofi
usra2 = "O" & lafice + 6
MsgBox usra1
MsgBox usra2
Sheets("Leben & Rente").Range("A" & cetofi & ":O" & (cetofi + lafice - 1)).Value = _
Sheets("Arbeitsbereich").Range("A1:O" & lafice).Value
Hier kommt die Fehlermeldung zum Überlauf!
'Allgemeine Formatierung
Sheets("Leben & Rente").Activate
FormData
'Spalten in richtiges Format bringen
FormColumn
'Zahlweise formatieren
FormZW
'Arbeitsbereich leeren
Clearing
cetofi = cetofi + lafice
ElseIf kat = "BSV" Then
MsgBox ip
ElseIf kat = "KRV" Then
MsgBox kat
ElseIf kat = "HPV" Then
MsgBox kat
ElseIf kat = "EDV" Then
MsgBox kat
ElseIf kat = "GGV" Then
MsgBox kat
ElseIf kat = "BAU" Then
MsgBox kat
ElseIf kat = "UNF" Then
MsgBox kat
ElseIf kat = "HRV" Then
MsgBox kat
ElseIf kat = "TRP" Then
MsgBox kat
ElseIf kat = "BUV" Then
MsgBox kat
ElseIf kat = "WGV" Then
ElseIf kat = "RSV" Then
ElseIf kat = "FEU" Then
ElseIf kat = "BHV" Then
Else
End If
End Sub
Stört euch bitte nicht an den vielen MsgBoxen, die dienen hauptsächlich der Kontrolle. Auch manche Variablen sind teilweise nicht mehr ganz so nötig wie sie hier teilweise noch stehen.
Vielen Dank schon mal für eure Hilfe
Grüße
Christopher