Ausschneiden und Anfügen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Ausschneiden und Anfügen
von: Peter
Geschrieben am: 07.11.2003 09:18:59

Hallo Excels,
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

Bild


Betrifft: AW: Ausschneiden und Anfügen
von: Beni
Geschrieben am: 08.11.2003 17:41:45

Hallo Peter,
probiere dieses Makro, das geht ohne Autofilter.
Gruss Beni

Option Explicit

Sub lagerauswahl()
Dim sort, lager, r, L, i, a
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
   r = Cells(65536, 1).End(xlUp).Row + 1
For i = 1 To r
If Cells(i, 11) = sort Then
   With Sheets("rep")
      L = .Cells(65536, 1).End(xlUp).Row + 1
    For a = 1 To 11
      .Cells(L, a).Value = Cells(i, a).Value
    Next a
   End With
  Range(Cells(i, 1), Cells(i, 11)).EntireRow.Delete
End If
Next i
    Sheets("rep").Select
End Sub



Bild


Betrifft: AW: Ausschneiden und Anfügen
von: peter
Geschrieben am: 10.11.2003 09:31:03

Hi Beni,
danke für deine Antwort.
Leider funktioniert das Makro nicht. Es wird nur das Blatt gewechselt und das wars.
Gruss
Peter


Bild

Beiträge aus den Excel-Beispielen zum Thema " Mehrere Werte einer Funktion übergeben"