Option Explicit Sub Swap() Application.ScreenUpdating = False Sheets("X").Select Dim c, firstAddress Dim strSuch As String, rngBer As Range Set rngBer = Range("A3:A" & Range("A6999").End(xlUp).Row) With rngBer strSuch = Sheets("Y").Range("A12").Value If strSuch = "" Then Exit Sub End If Set c = .Find(strSuch, LookIn:=xlValues) If c Is Nothing Then MsgBox "Drucker nicht vorhanden" Exit Sub Else firstAddress = c.Address Do c.Activate Loop While Not c Is Nothing And c.Address <> firstAddress Sheets("X").Select ActiveCell.Copy Sheets("Historie").Select Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Sheets("X").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 1).Copy Sheets("A").Select Range("A1").End(xlDown).Offset(0, 1).PasteSpecial Sheets("X").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 4).Copy Sheets("A").Select Range("A1").End(xlDown).Offset(0, 2).PasteSpecial Sheets("X").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 4).Copy Sheets("A").Select Range("A1").End(xlDown).Offset(0, 2).PasteSpecial Sheets("X").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 5).Copy Sheets("A").Select Range("A1").End(xlDown).Offset(0, 3).PasteSpecial Sheets("X").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 6).Copy Sheets("A").Select Range("A1").End(xlDown).Offset(0, 4).PasteSpecial Sheets("X").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 7).Copy Sheets("A").Select Range("A1").End(xlDown).Offset(0, 5).PasteSpecial Sheets("X").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 9).Copy Sheets("A").Select Range("A1").End(xlDown).Offset(0, 6).PasteSpecial Sheets("X").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 8) = Sheets("Y").Range("F12").Value Sheets("Y").Range("A12:J12").Copy Sheets("A").Select Range("A65536").End(xlUp).Select Cells(ActiveCell.Row + 1, ActiveCell.Column - 0).PasteSpecial Application.CutCopyMode = False Sheets("Y").Select Sheets("Y").Range("H12:J12").Copy Sheets("A").Select Range("A65536").End(xlUp).Select Cells(ActiveCell.Row - 1, ActiveCell.Column + 7).PasteSpecial Application.CutCopyMode = False Sheets("Y").Select Sheets("X").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 5).Copy Sheets("A").Select Range("A1").End(xlDown).Offset(0, 3).PasteSpecial Sheets("X")."Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 7).Copy Sheets("A").Select Range("A1").End(xlDown).Offset(0, 5).PasteSpecial End If End With End Sub
Option Explicit Sub Swap() Dim c As Range, firstAddress As String Dim strSuch As String, rngBer As Range Set rngBer = Sheets("X").Range("A3:A" & Sheets("X").Range("A6999").End(xlUp).Row) Application.ScreenUpdating = False With rngBer If Sheets("Y").Range("A12") <> "" Then Set c = .Find(strSuch, LookIn:=xlValues) If c Is Nothing Then MsgBox "Drucker nicht vorhanden" Exit Sub Else firstAddress = c.Address Do c.Copy Sheets("Historie").Range("A1").End(xlDown).Offset(1, 0).PasteSpecial c.Offset(0, 1).Copy Sheets("A").Range("A1").End(xlDown).Offset(0, 1).PasteSpecial c.Offset(0, 4).Copy Sheets("A").Range("A1").End(xlDown).Offset(0, 2).PasteSpecial c.Offset(0, 5).Copy Sheets("A").Range("A1").End(xlDown).Offset(0, 3).PasteSpecial c.Offset(0, 6).Copy Sheets("A").Range("A1").End(xlDown).Offset(0, 4).PasteSpecial c.Offset(0, 7).Copy Sheets("A").Range("A1").End(xlDown).Offset(0, 5).PasteSpecial c.Offset(0, 9).Copy Sheets("A").Range("A1").End(xlDown).Offset(0, 6).PasteSpecial c.Offset(0, 8) = Sheets("Y").Range("F12").Value Sheets("Y").Range("A12:J12").Copy Sheets("A").Cells(Sheets("A").Range("A65536").End(xlUp) + 1, 1).PasteSpecial Sheets("Y").Range("H12:J12").Copy Sheets("A").Cells(Sheets("A").Range("A65536").End(xlUp) - 1, 8).PasteSpecial Application.CutCopyMode = False Set c = .FindNext(strSuch) Loop While Not c Is Nothing And c.Address <> firstAddress End If End If End With End Sub
Option Explicit Sub Umzug() Application.ScreenUpdating = False Sheets("IST Januar 2009").Select Dim c, firstAddress Dim strSuch As String, rngBer As Range Set rngBer = Range("A3:A" & Range("A7").End(xlUp).Row) With rngBer strSuch = Sheets("Makros").Range("A5").Value If strSuch = "" Then Exit Sub End If Set c = .Find(strSuch, LookIn:=xlValues) If c Is Nothing Then MsgBox "Eintrag nicht vorhanden" Exit Sub Else firstAddress = c.Address Do c.Activate Loop While Not c Is Nothing And c.Address <> firstAddress Sheets("IST Januar 2009").Select ActiveCell.Copy Sheets("Druckerhistorie").Select Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Sheets("IST Januar 2009").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 1).Copy Sheets("Druckerhistorie").Select Range("A1").End(xlDown).Offset(0, 1).PasteSpecial Sheets("IST Januar 2009").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 4).Copy Sheets("Druckerhistorie").Select Range("A1").End(xlDown).Offset(0, 2).PasteSpecial Sheets("IST Januar 2009").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 4).Copy Sheets("Druckerhistorie").Select Range("A1").End(xlDown).Offset(0, 2).PasteSpecial Sheets("IST Januar 2009").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 5).Copy Sheets("Druckerhistorie").Select Range("A1").End(xlDown).Offset(0, 3).PasteSpecial Sheets("IST Januar 2009").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 6).Copy Sheets("Druckerhistorie").Select Range("A1").End(xlDown).Offset(0, 4).PasteSpecial Sheets("IST Januar 2009").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 7).Copy Sheets("Druckerhistorie").Select Range("A1").End(xlDown).Offset(0, 5).PasteSpecial Sheets("IST Januar 2009").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 9).Copy Sheets("Druckerhistorie").Select Range("A1").End(xlDown).Offset(0, 6).PasteSpecial Sheets("IST Januar 2009").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = Sheets("Makros").Range("B5").Value Cells(ActiveCell.Row + 0, ActiveCell.Column + 6) = Sheets("Makros").Range("E5").Value Cells(ActiveCell.Row + 0, ActiveCell.Column + 9) = Sheets("Makros").Range("G5").Value Sheets("Makros").Range("A5:J5").Copy Sheets("Druckerhistorie").Select Range("A65536").End(xlUp).Select Cells(ActiveCell.Row + 1, ActiveCell.Column - 0).PasteSpecial Application.CutCopyMode = False Sheets("Makros").Select Sheets("Makros").Range("H5:J5").Copy Sheets("Druckerhistorie").Select Range("A65536").End(xlUp).Select Cells(ActiveCell.Row - 1, ActiveCell.Column + 7).PasteSpecial Application.CutCopyMode = False Sheets("Makros").Select Sheets("IST Januar 2009").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 5).Copy Sheets("Druckerhistorie").Select Range("A1").End(xlDown).Offset(0, 3).PasteSpecial Sheets("IST Januar 2009").Select Cells(ActiveCell.Row + 0, ActiveCell.Column + 7).Copy Sheets("Druckerhistorie").Select Range("A1").End(xlDown).Offset(0, 5).PasteSpecial End If End With End Sub
Set c = .Find(Sheets("Y").Range("A12"), LookIn:=xlValues)
58.4k Fragen
249k Antworten
7k Nutzer