Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA-Makro Zellen verschieben
#1
Hallo zusammen ich steh total auf dem Schlauch 17 ich habe Daten aus einer Tabelle aus SAP über Acrobat nach Excel exportiert. Die ausgelesenen Daten sollen (in die richtigen Spalten) in Excel eingeordnet werden.
Ich möchte die Tabelle in der Spalte N nach einem gewissen Kriterium filtern und dann in den gefilterten Zellen den Wert (Datum) der aus der Spalte N nach Spalte L (Zellen sind leer) verschoben wird (=> zwei Spalten nach links). Anschließend sollen noch die Werte der selben Zeile von Spalte O-T nach Spalte N-S verschoben werden (=> eine Spalte nach links). Die "ausgeblendeten" Zeilen dürfen nicht mit verschoben o.a. werden, da diese die gewünschte Spaltenstruktur schon haben. das Filterkriterium wird (soll) anschließend im VBA manuell angepasst werden. Die Orginaltabelle hat insgesamt über 100.000 Datensätze aus SAP. Aus den unten beigefügten Makros wollte ich mir irgendetwas zusammenbasteln.

Code:
Sub NurGefilterteKopieren()

  Dim tblRow1 As Integer, lRow As Integer
  Dim tblName As String
  tblName = "Mappe1"
  tblRow1 = Range(Tabelle1).Row
  With ListObjects(tblName)
      lRow = .ListRows.Count + 1
      .Range.AutoFilter Field:=14, Operator:= _
        xlFilterValues, Criteria2:=Array(0, "12/31/2001")
      Range("N" & tblRow1 - 2).Copy
      End With
  End Sub 

Sub Makro1()

Dim i As Integer
    ActiveSheet.Range("$A$1:$AC$101656").AutoFilter Field:=14, Operator:= _
        xlFilterValues, Criteria2:=Array(0, "12/31/2001")
    Range("N16861").Select
    Selection.Cut Destination:=Range("L16861")
    Range("O16861:T16861").Select
    Selection.Cut Destination:=Range("N16861:S16861")
    Range("N16861:S16861").Select
End Sub

Sub Zeilen_C_markieren()

Dim rngFilterCell As Range
For Each rngFilterCell In Range("n2:n" & Range("n101656").End(xlUp).Row).SpecialCells(12)
Range(rngFilterCell.Address).Select
MsgBox "SoSo"
Next
End Sub

Hoffentlich könnt ihr mir helfen :D 
Danke & Gruß Addi


Angehängte Dateien
.xlsx   Mappe1a.xlsx (Größe: 11,62 KB / Downloads: 3)
Antwortento top
#2
Hi Addi

dieser Code, den Du in ein Modul einfügst, verschiebt von allen nach Filterung sichtbaren Zeilen die Zelle N nach L und die Zellen O:T nach N:S.

Code:
Sub Filterung()
   
    Dim b As Range
    Set b = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
   
    Dim a As Range
    For Each a In b.Areas
       
        Dim d As Range
        For Each d In a.Rows
            With d
                If .Row <> 1 Then
               
                    .Cells(1, "N").Copy .Cells(1, "L")
                    .Range(Cells(1, "O"), Cells(1, "T")).Copy .Cells(1, "N")
                    .Cells(1, "T").Clear
                   
                End If
            End With
        Next d
    Next a
End Sub

Bitte testen.

Viel Erfolg,
wünscht Raoul
Antwortento top
#3
hat perfekt funktioniert  05

ich habe es so noch "probiert", aber der Erfolg war .. ok lassen wir das 20


Code:
Sub Makro3()
Dim i As Long
    ' ActiveSheet.Range("$A$1:$AC$101656").AutoFilter Field:=14, Operator:= _
        xlFilterValues, Criteria2:=Array(0, "12/31/2001")
    'ActiveSheet.Range("$A$1:$AC$101656").AutoFilter Field:=15, Criteria1:= _
        "DB056B2"
    For i = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
      If Rows(i).Hidden = False Then
        Cells(i, 14).Select
        Selection.Cut
        Cells(i, 12).Select
        ActiveSheet.Paste
        Range(Cells(i, 15), Cells(i, 20)).Select
        Selection.Cut
        Cells(i, 14).Select
        ActiveSheet.Paste
        ActiveSheet.Range("$A$1:$AC$101656").AutoFilter Field:=14
        ActiveSheet.Range("$A$1:$AC$101656").AutoFilter Field:=15
        ActiveSheet.Range("$A$1:$AC$101656").AutoFilter Field:=14, Operator:= _
        xlFilterValues, Criteria2:=Array(0, "12/31/2001")
        ActiveSheet.Range("$A$1:$AC$101656").AutoFilter Field:=15, Criteria1:= _
        "DB056B2"
        Exit For
      End If
    'ActiveWorkbook.Save
  Next i
End Sub


Vielen Vielen.. vielen DANK Raoul
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste