Hallo Rainer,
anbei das Makro. Unten aufgeführt ist auch noch das andere Modul, welches im Makro mit Call aufgerufen wird.
Sub SätzeAufAnderesTabellenblattÜbertragen1()
With Application.VBE.MainWindow
.Visible = Not .Visible
End With
Const Blatt1 = "Abrechnung_Prüfprotokoll"
Const Blatt2 = "Tabelle1"
Dim i As Integer
Dim iAnz As Integer
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Sheets(Blatt2).Select
Range("a2:ar10000").Select
'Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Sheets(Blatt2).Activate
Range("A2").Select
Sheets(Blatt1).Activate
Range("A1").Select
iAnz = 0
i = 0
Call Erste_Zelle
ActiveCell.Offset(0, 28).Select
Do Until iAnz = 150
If IsEmpty(Cells(ActiveCell.Row, 29)) = True Then Exit Do
If ActiveCell.Value = Range("b2") Then
Selection.EntireRow.Copy
Sheets(Blatt2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
Sheets(Blatt1).Select
ActiveCell.Offset(1, 0).Select
iAnz = iAnz + 1
Else
ActiveCell.Offset(1, 0).Select
End If
i = i + 1
Loop
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Call Daten_holen
Windows("Work Order_IPC_Viewer.xls").Activate
Sheets("Prüfprotokoll").Select
Application.CutCopyMode = False
End Sub
*************************************************************************
Sub Daten_holen()
'
' Daten_holen Makro
'
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Sheets("Tabelle1").Select
Range("Ao2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-32]="""","""",RC[-32]&""-""&RC[-31]&""-""&RC[-30]&""-""&RC[-29]&RC[-28])"
Selection.AutoFill Destination:=Range("AO2:AO1001"), Type:=xlFillDefault 'schreibt die Figurnummer in Spalte AO
'kopieren der daten in das Datenänderungssheet
Range("AP2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-26]="""","""",SUMIF(R2C41:R1000C41,RC[-1],R2C16:R1000C16))"
Range("AQ2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-26]="""","""",SUMIF(R2C41:R1000C41,RC[-2],R2C17:R1000C17))"
Range("AR2").Select
ActiveCell.FormulaR1C1 = _
"=IF(COUNTIF(R2C41:RC[-3],RC[-3])=1,MAX(R1C44:R[-1]C)+1,IF(COUNTIF(R2C41:RC[-3],RC[-3])>1,INDEX(C,MATCH(RC[-3],C[-3],0)),""""))"
Range("AP2:Ar2").Select
Selection.AutoFill Destination:=Range("AP2:Ar1001"), Type:=xlFillDefault
'*********Filtern von 1-15
Range("A1:AR1").Select
ActiveSheet.Range("$A$1:$AR$1001").AutoFilter Field:=44, Criteria1:=Array( _
"1", "10", "11", "12", "13", "14", "15", "2", "3", "4", "5", "6", "7", "8", "9"), Operator _
:=xlFilterValues
ActiveSheet.Range("$A$1:$AR$1001").AutoFilter Field:=44, Criteria1:=Array( _
"1", "10", "11", "12", "13", "14", "15", "2", "3", "4", "5", "6", "7", "8", "9"), Operator _
:=xlFilterValues
Worksheets("Tabelle1").Calculate
Application.Goto Reference:="filter_doppel"
'************
'formel für Aufzählung einfügen
Range("A2:AO1000").Select
Selection.Copy
Sheets("Datenänderung").Select
Range("a2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle1").Select
Range("ap2:aq101").Select
Selection.Copy
Range("p2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A:$AO").RemoveDuplicates Columns:=41, Header:=xlYes 'doppelte Einträge werden gelöscht
Range("A2:A1000").Select
Selection.Copy
Sheets("Prüfprotokoll").Select
Range("D7").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("F27").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("A10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle1").Select
Range("B2:B16").Select
Range("AO2:AO16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle1").Select
Range("C2:C16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Prüfprotokoll").Select
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle1").Select
Range("AO2:AO16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Prüfprotokoll").Select
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle1").Select
ActiveWindow.SmallScroll ToRight:=12
Range("P2:Q16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Prüfprotokoll").Select
Range("D10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle1").Select
Range("V2:V16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Prüfprotokoll").Select
Range("F10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("List of Workorders (VIEW)").Select
Range("AD2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Prüfprotokoll").Select
Range("G10:G24").Select
Selection.PasteSpe