5 Makros in 1 zusammenfassen
20.09.2006 11:23:46
grossermanitu
Ich habe 5 verschiedene Makros. Ich möchte gerne das alle hintereinander ablaufen. Leider wird mir immer ein Fehler angezeigt, wenn ich alle einfach hintereinander kopiere und die SUBs dementsprechend lösche
der einfachheit halber habe ich alle Makros in ihrer ursprünglichen Form mit angefügt
Wäre klasse wenn mir jemand helfen könnte. Danke im voraus.
Sub retas_import()
' Makro1 Makro
' Makro am 19.09.2006 von DaimlerChrysler aufgezeichnet
Sheets("Import").Select
Cells.Select
Range("A82").Activate
Selection.Delete Shift:=xlUp
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;G:\FbCopy\FB700\RETAS_Liste\Retas_Liste.txt", Destination:=Range("A1"))
.Name = "Retas_Liste"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Sub retas_Loesche_V_Auftraege()
Dim Zelle As Object, spalte As Object
Dim such, min
Set spalte = [A:A] 'Text in Spalte B suchen, ggf,. anpassen
such = "gewandelte" 'Alle Zellen, die das Wort "liste" enthalten
Set Zelle = spalte.Find(such)
While Not Zelle Is Nothing
min = Application.min(Zelle.Row - 1, 6) 'Falls VOR Zeile 10
Range(Zelle.Offset(-min), Zelle.Offset(44)).EntireRow.Delete
Set Zelle = spalte.FindNext
Wend
End Sub
Sub retas_Loesche7bis10()
Dim Zelle As Object, spalte As Object
Dim such, min
Set spalte = [A:A] 'Text in Spalte B suchen, ggf,. anpassen
such = "teams" 'Alle Zellen, die das Wort "liste" enthalten
Set Zelle = spalte.Find(such)
While Not Zelle Is Nothing
min = Application.min(Zelle.Row - 1, 10) 'Falls VOR Zeile 10
Range(Zelle.Offset(-min), Zelle.Offset(7)).EntireRow.Delete
Set Zelle = spalte.FindNext
Wend
End Sub
Sub retas_Loesche_Loeschlauf()
Dim Zelle As Object, spalte As Object
Dim such, min
Set spalte = [A:A] 'Text in Spalte B suchen, ggf,. anpassen
such = "loeschlauf" 'Alle Zellen, die das Wort "liste" enthalten
Set Zelle = spalte.Find(such)
While Not Zelle Is Nothing
min = Application.min(Zelle.Row - 1, 1) 'Falls VOR Zeile 10
Range(Zelle.Offset(-min), Zelle.Offset(1)).EntireRow.Delete
Set Zelle = spalte.FindNext
Wend
End Sub
Sub retas_copy()
' import Makro
' Makro am 18.09.2006 von DaimlerChrysler aufgezeichnet
Sheets("Zwischentabelle").Select
Cells.Select
Selection.ClearContents
Sheets("Import").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(23, 1), Array(27, 1), Array(29, 1), _
Array(31, 1), Array(37, 1), Array(47, 1)), TrailingMinusNumbers:=True
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").Select
Selection.Replace What:="=-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.Copy
Sheets("Zwischentabelle").Select
Cells.Select
ActiveSheet.Paste
Sheets("Endliste").Select
Cells.Select
Application.CutCopyMode = False
Cells.Select
Selection.Sort Key1:=Range("C2"), Order1:=xlDescending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("A2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
End Sub