Fehler in VBA Code
17.04.2014 21:37:53
Andy
wer kann Helfen?
Dieser VBA Code ist in einer Arbeitsmappe hinterlegt und holt sich Daten aus einer anderen Arbeitsmappe.
Hier ist allerdings eine Fehler im unteren Teil der so nicht funktioniert.
Kann von euch jemand darüberschauen und den Fehler erkennen oder beheben.
Vielen Dank im voraus
Sub Messdatei_oeffnen(KW As String)
Dim i As Long
Dim Zeilenzahl As Single
Dim Zeilenzahl_Chargen As Single
Dim Step1 As Single
Dim Step2 As Single
Dim Step3 As Single
Dim wsSource As Worksheet
Dim wsTarget0 As Worksheet
Dim wsTarget1 As Worksheet
Dim wsTarget2 As Worksheet
Set wsTarget0 = ActiveWorkbook.Worksheets("VBA_Urdaten0")
Set wsTarget1 = ActiveWorkbook.Worksheets("VBA_Urdaten")
Set wsTarget2 = ActiveWorkbook.Worksheets("VBA_aufbereitete_Meßdaten")
'VBA_Urdaten auf Ursprung "VBA_Urdaten0" zurücksetzen
wsTarget0.Range("$A$1:$EP$100").Copy
'Ursprung "VBA_Urdaten0" einfügen und alle Chargen löschen
wsTarget1.Range("A2").PasteSpecial xlPasteAll
'?Zeilenhöhe 2 auf 30 setzen
Application.ScreenUpdating = False
Workbooks.Open "C:\Users\Andy\Documents\Arbeitsmappe.xlsm"
Set wsSource = Sheets("7±0,005")
wsSource.Unprotect Password:="läppen"
'nach KW filtern
wsSource.Range("$A$3:$EP$2300").AutoFilter Field:=1, Criteria1:=Array(KW), Operator:= _
xlFilterValues
'nach Art.-Nr. filtern -> für 60, 100, 160, 250, 400, 600 bar sortieren
wsSource.Range("$A$3:$EP$2300").AutoFilter Field:=4, Criteria1:=Array("14056130", "14056133" _
_
_
_
, "14056135", "14056136", "14074496", "14056147"), Operator:=xlFilterValues
'gefilterte Daten kopieren
wsSource.AutoFilter.Range.Copy
'gefilterte Daten einfügen
wsTarget1.Range("A4").PasteSpecial xlPasteAll
'zum Schliessen der wsSource
'?Weshalb ist wsSource nocht aktiv, da in wsTarget1 eingefügt?
ActiveWindow.Close
'?Fenster "Speichern" und "Datenmenge zur Verfügung stellen" auch per Makro schließen?
' Call Messwerte_Target1_aufbereiten(wsTarget1)
' Call Messwerte_Target2_aufbereiten(wsTarget1, wsTarget2)
'End Sub
'
'
Sub Messwerte_Target1_aufbereiten(wsTarget1)
' Dim Zeilenzahl As Single
' Dim Zeilenzahl1 As Single
wsTarget1.Columns("P:Q").Delete Shift:=xlToLeft
wsTarget1.Columns("Q:R").Delete Shift:=xlToLeft
wsTarget1.Columns("R:S").Delete Shift:=xlToLeft
wsTarget1.Columns("S:T").Delete Shift:=xlToLeft
wsTarget1.Columns("T:U").Delete Shift:=xlToLeft
wsTarget1.Columns("U:V").Delete Shift:=xlToLeft
wsTarget1.Columns("V:W").Delete Shift:=xlToLeft
wsTarget1.Columns("W:X").Delete Shift:=xlToLeft
wsTarget1.Columns("X:Y").Delete Shift:=xlToLeft
wsTarget1.Columns("Y:Z").Delete Shift:=xlToLeft
wsTarget1.Columns("Z:AA").Delete Shift:=xlToLeft
wsTarget1.Columns("AA:AB").Delete Shift:=xlToLeft
wsTarget1.Columns("AB:AC").Delete Shift:=xlToLeft
wsTarget1.Columns("AC:AD").Delete Shift:=xlToLeft
wsTarget1.Columns("AD:AE").Delete Shift:=xlToLeft
wsTarget1.Columns("AE:AF").Delete Shift:=xlToLeft
wsTarget1.Columns("AF:AG").Delete Shift:=xlToLeft
wsTarget1.Columns("AG:AH").Delete Shift:=xlToLeft
wsTarget1.Columns("AH:AI").Delete Shift:=xlToLeft
wsTarget1.Columns("AI:AJ").Delete Shift:=xlToLeft
wsTarget1.Columns("AJ:AK").Delete Shift:=xlToLeft
wsTarget1.Columns("AK:AL").Delete Shift:=xlToLeft
wsTarget1.Columns("AL:AM").Delete Shift:=xlToLeft
wsTarget1.Columns("AM:AN").Delete Shift:=xlToLeft
wsTarget1.Columns("AN:AO").Delete Shift:=xlToLeft
wsTarget1.Columns("AO:AP").Delete Shift:=xlToLeft
wsTarget1.Columns("AP:AQ").Delete Shift:=xlToLeft
wsTarget1.Columns("AQ:AR").Delete Shift:=xlToLeft
wsTarget1.Columns("AR:AS").Delete Shift:=xlToLeft
wsTarget1.Columns("AS:AT").Delete Shift:=xlToLeft
wsTarget1.Columns("AT:AU").Delete Shift:=xlToLeft
wsTarget1.Columns("AU:AV").Delete Shift:=xlToLeft
wsTarget1.Columns("AV:AW").Delete Shift:=xlToLeft
wsTarget1.Columns("AW:AX").Delete Shift:=xlToLeft
wsTarget1.Columns("AX:AY").Delete Shift:=xlToLeft
wsTarget1.Columns("AY:AZ").Delete Shift:=xlToLeft
'?Wieviele Zeilen mit Messwerten gibt es?
'Range("A5").Select
Zeilenzahl = Selection.CurrentRegion.Rows.Count
Zeilenzahl_Chargen = Zeilenzahl - 4
' wsTarget1.Cells(30, "A") = Zeilenzahl
wsTarget1.Cells(30, "B") = "Zeilenzahl: " & Zeilenzahl
wsTarget1.Cells(30, "C") = "Zeilenzahl_Chargen: " & Zeilenzahl_Chargen
' 'zählt inkl. Leerzeilen
' Zeilenzahl1 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
' wsTarget1.Cells(31, "A") = Zeilenzahl1
' wsTarget1.Cells(31, "B") = "Zeilenzahl1: " & Zeilenzahl1
'?Zelle A2 auswählen
'?Autosize Breite aller Spalten?
'End Sub
'
'
Sub Messwerte_Target2_aufbereiten(wsTarget1, wsTarget2)
'Inhalt komplett gelöscht
wsTarget2.UsedRange.ClearContents
'Tabellenkopf definieren
wsTarget1.Range("N3").Copy
wsTarget2.Cells(1, "A").PasteSpecial
wsTarget1.Cells(2, "N").Copy
wsTarget2.Cells(1, "B").PasteSpecial
'kopieren des Tabellenkopfes aus Target1
wsTarget1.Range("A4:N4").Copy
'einfügen des Tabellenkopfes in Target2
wsTarget2.Range("C1").PasteSpecial
'?Layout Tabellenkopf machen?
'Messwerte aufbereiten
'Schleife wird bei Zeilenzahl_Charge = 0 sofort beendet
Do
'Zeilenzahl_Chargen = Zeilenzahl_Chargen - 1
'Cells(Zeilenzahl_Chargen + 40, "B").Value = Zeilenzahl_Chargen
Step3 = 5
'kopieren der Zeile "Aufnehmer# und GTF-Position" aus Target1
wsTarget1.Range("O3:AX3").Copy
'transponieren und einfügen der Zeile "Aufnehmer# und GTF-Position" in Target2
wsTarget2.Cells(2 + Step2, "A").PasteSpecial Transpose:=True
'kopieren der Messwerte aus Target1
wsTarget1.Range("O5:AX5").Copy
'transponieren und einfügen der Messwerte in Target2
wsTarget2.Cells(2, "B").PasteSpecial Transpose:=True
'kopieren der Kopfdaten aus Target1 und einfügen der Kopfdaten in Target2
wsTarget1.Range("A5:N5").Copy
'wsTarget1.Range(Cells(5 + Step1, 1), Cells(5 + Step1, 14)).Copy Destination:=wsTarget2. _
_
_
_
Range(Cells(2 + Step2, "C"), Cells(2 + Step2, "P"))
'wsTarget1.Range(Cells(5, 1), Cells(5, 14)).Copy
wsTarget2.Range("C2:C37").PasteSpecial
Step1 = Step1 + 1
Step2 = Step2 + 36
'Step3 = Step3 + 1
'Cells(Step2 + 60, "D").Value = Step1
'Loop Until Zeilenzahl_Chargen = 0
Loop Until Step1 = Zeilenzahl_Chargen
Application.ScreenUpdating = True
wsTarget2.Select
' 'kopieren der Zeile "Aufnehmer# und GTF-Position" aus Target1
' wsTarget1.Range("O3:AX3").Copy
' 'transponieren und einfügen der Zeile "Aufnehmer# und GTF-Position" in Target2
' wsTarget2.Range("A2" + Step).PasteSpecial Transpose:=True
' 'kopieren der Messwerte aus Target1
' wsTarget1.Range("O5:AX5").Copy
' 'transponieren und einfügen der Messwerte in Target2
' wsTarget2.Range("B2" + Step).PasteSpecial Transpose:=True
' 'kopieren der Kopfdaten in Target1
' '?Wie bekomme ich das zum Laufen?
' 'With ThisWorkbook.wsTarget1
' ' .Range("A5:N5").Copy Destination:=wsTarget2.Range("C2:P" & .Range("A65536").End( _
_
_
_
xlUp).Row)
' 'End With
' 'kopieren der Kopfdaten aus Target1
' wsTarget1.Range("A5:N5").Copy
' 'einfügen der Kopfdaten in Target2
' wsTarget2.Range("C2:P37").PasteSpecial
'?Autosize Breite aller Spalten?
'?In einzelne Sub's auftrennen?
'?Wie Abschnitssweise testen?
'wie Befehle als Auswahl -> Autovervollständigen?
End Sub