Ausschneiden und Anfügen
07.11.2003 09:18:59
Peter
In einer Tabelle möchte ich folgendes erreichen.
Die Mappe hat sechs Tabellen. Alle Tabellen sind gleich aufgebaut.
In den Tabellen sind in den Spalten A-K Einträge enthalten.
Über eine Inputbox möchte zuerst ein Tabellenblatt auswählen.(klappt schon mal)
Eine zweite Inputbox fragt nun in dem gewähten Tabelleblatt einen Eintrag aus Spalte K ab.(klappt auch noch)
Diese Zeilen sollen dann in der Ursprungsmappe gelöscht und in das Tabelleblatt "rep" angefügt werden.
Mein Ergebniss sieht nun so aus, dass die gewählten Zeilen zwar ausgewählt und kopiert werden. Aber wie lösche ich die Zeilen im Blatt und wie bekomme ich das mit dem anfügen hin.
Bei mir werden die zeilen im Blatt "rep" immer überschrieben.
Hilfe wäre echt toll
Gruss Peter
Option Explicit
Sub lagerauswahl()
Dim sort
Dim lager
Dim blatt As String
blatt = Application.ActiveSheet.Name
Sheets("rep").Select
lager = Application.InputBox("Schreiben sie das Lager ein" & Chr(13) _
& "Beispiel => L35", "Lager auswahl")
If lager = False Then
MsgBox "Eingabe wurde abgebrochen!"
ThisWorkbook.Sheets(blatt).Activate
Exit Sub
ElseIf lager = "" Then
MsgBox "Nix eingegeben!"
ThisWorkbook.Sheets(blatt).Activate
Exit Sub
Else
'MsgBox lager & " wurde eingegeben!"
End If
sort = Application.InputBox("Geben Sie den Palettennummer ein:")
If sort = False Then
MsgBox "Eingabe wurde abgebrochen!"
ThisWorkbook.Sheets(blatt).Activate
Exit Sub
ElseIf sort = "" Then
MsgBox "Nix eingegeben!"
ThisWorkbook.Sheets(blatt).Activate
Exit Sub
Else
'MsgBox sort & " wurde eingegeben!"
End If
Sheets(lager).Select
'Call anfügen
Sheets(lager).Select
With Range("a1")
.AutoFilter Field:=11, Criteria1:=sort
.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("rep").Range("a1")
Sheets("rep").Select
'übernahmelöschen
Selection.AutoFilter
Range("a65536").Value = lager
Range("a1").Select
End With
Sheets(lager).Select
Selection.AutoFilter Field:=11
Sheets("rep").Select
End Sub
Sub anfügen()
Sheets("rep").Select
Range("b2").Select
' Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Activate
End Sub