Habe eine Spalte helöscht / Problem mit Makro

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

Betrifft: Habe eine Spalte helöscht / Problem mit Makro
von: Jenny
Geschrieben am: 19.07.2015 23:39:48

Hallo an alle,
habe folgendes Makro gehabt

Sub Makro3()
'
' Makro3 Makro
'
' Tastenkombination: Strg+i
'
      Dim zt1&, von&, bis As Long
      Dim Grafiken As Shape
 '*****************
      Dim c As Range, a As Variant
 '*****************
      Application.ScreenUpdating = False
      With Sheets("Tabelle1")
          zt1 = .Cells(.Rows.Count, 1).End(xlUp).Row
          von = 1
          With Sheets("Tabelle2")
              bis = .Cells(.Rows.Count, 2).End(xlUp).Row
              'Inhalt Spalte B nach tabelle1 kopieren
              .Range(.Cells(von, 2), .Cells(bis, 2)).Copy Sheets("Tabelle1").Cells(zt1, 7)
          End With
          With Sheets("Tabelle3")
              'Inhalt aus Spalte E kopieren
              .Range(.Cells(von, 5), .Cells(bis, 5)).Copy
          End With
          'In Spalte H einfügen
          .Cells(zt1, 8).PasteSpecial Paste:=xlPasteValues
          Application.CutCopyMode = False
         If bis > 1 Then
           'Spalte A bis C durch kopieren auffüllen
              .Range(.Cells(zt1, 1), .Cells(zt1, 3)).Copy _
               Destination:=.Range(.Cells(zt1 + 1, 1), .Cells(zt1 + bis - von, 1))
         End If
          Application.CutCopyMode = False
          With Sheets("Tabelle1")
          Range(.Cells(zt1 - 1, 4), .Cells(zt1 - 1, 5)).Copy _
          Destination:=.Range(Cells(zt1, 4), Cells(zt1 + bis - von, 4))
          Application.CutCopyMode = False
          End With
 '         Stop
 '*****************
          For Each c In Range(.Cells(zt1, 7), .Cells(zt1 + bis - von, 7))
            If c.Hyperlinks.Count > 0 Then
               a = Split(c.Hyperlinks(1).Address, "/")
 '              For i = 1 To UBound(a): MsgBox a(i): Next
               c.Offset(0, -1).Value = a(UBound(a) - 1)
            End If
          Next
 '*****************
          'Daten nach Spalte E aufsteigend, dann H absteigend sortieren
         .Range(.Cells(1, 1), .Cells(zt1 + 1 + bis - von, 15)).Sort _
          key1:=.Range("E1"), Order1:=xlAscending, _
         key2:=.Range("H1"), Order2:=xlDescending, Header:=xlNo
      End With
      With Sheets("Tabelle2")
          'Daten in Spalten A bis C löschen
          .Range(.Cells(1, 1), .Cells(bis, 3)).Clear
      End With
      With Sheets("Tabelle3")
          'Daten in Spalten A bis D  löschen
       .Range(.Cells(1, 1), .Cells(bis, 4)).Clear
        For Each Grafiken In .Shapes
              Grafiken.Delete
        Next
      End With
      Application.ScreenUpdating = True
End Sub
welches funktioniert hat,
habe jetzt in der Tabelle Spalte D gelöscht, somit ist jetzt Spalte E die Spalte D, die Spalte F ist jetzt Spalte E usw.
und habe dann versucht das Makro anzupassen und bin jetzt soweit:
Sub Makro3()
'
' Makro3 Makro
'
' Tastenkombination: Strg+i
'
      Dim zt1&, von&, bis As Long
      Dim Grafiken As Shape
 '*****************
      Dim c As Range, a As Variant
 '*****************
      Application.ScreenUpdating = False
      With Sheets("Tabelle1")
          zt1 = .Cells(.Rows.Count, 1).End(xlUp).Row
          von = 1
          With Sheets("Tabelle2")
              bis = .Cells(.Rows.Count, 2).End(xlUp).Row
              'Inhalt Spalte B nach tabelle1 kopieren
              .Range(.Cells(von, 2), .Cells(bis, 2)).Copy Sheets("Tabelle1").Cells(zt1, 6)
          End With
          With Sheets("Tabelle3")
              'Inhalt aus Spalte E kopieren
              .Range(.Cells(von, 5), .Cells(bis, 7)).Copy
          End With
          'In Spalte H einfügen
          .Cells(zt1, 7).PasteSpecial Paste:=xlPasteValues
          Application.CutCopyMode = False
         If bis > 1 Then
           'Spalte A bis C durch kopieren auffüllen
              .Range(.Cells(zt1, 1), .Cells(zt1, 3)).Copy _
               Destination:=.Range(.Cells(zt1 + 1, 1), .Cells(zt1 + bis - von, 1))
         End If
          Application.CutCopyMode = False
          
    Sheets("Tabelle1").Range("D" & zt1 - 1).Copy _
    Sheets("Tabelle1").Range("D" & zt1 + bis - von)
 '         Stop
 '*****************
          For Each c In Range(.Cells(zt1, 6), .Cells(zt1 + bis - von + 1, 5))
            If c.Hyperlinks.Count > 0 Then
               a = Split(c.Hyperlinks(1).Address, "/")
 '              For i = 1 To UBound(a): MsgBox a(i): Next
               c.Offset(0, -1).Value = a(UBound(a) - 1)
            End If
          Next
 '*****************
          'Daten nach Spalte E aufsteigend, dann H absteigend sortieren
         .Range(.Cells(1, 1), .Cells(zt1 + 1 + bis - von, 15)).Sort _
          key1:=.Range("D1"), Order1:=xlAscending, _
         key2:=.Range("G1"), Order2:=xlDescending, Header:=xlNo
      End With
      With Sheets("Tabelle2")
          'Daten in Spalten A bis C löschen
          .Range(.Cells(1, 1), .Cells(bis, 3)).Clear
      End With
      With Sheets("Tabelle3")
          'Daten in Spalten A bis D  löschen
       .Range(.Cells(1, 1), .Cells(bis, 4)).Clear
        For Each Grafiken In .Shapes
              Grafiken.Delete
        Next
      End With
      Application.ScreenUpdating = True
  End Sub
 
es kommt zwar keine Fehlermeldung, aber etwas funktioniert nicht so wie es soll, z.B. wird der Text in Spalte D nicht kopiert.
Könnt ihr mir helfen?
Viele Grüße und danke
Jenny

Bild

Betrifft: kleiner Nachtrag
von: Jenny
Geschrieben am: 19.07.2015 23:42:33
das +1 in

Sheets("Tabelle1").Range("D" & zt1 & ":E" & zt1 + bis - von + 1)
im ersten Makro hab ich im 2. Makro absichtlich herausgenommen, auch wenn es nichts mit der gelöschten Spalte zu tun hat.
Gruß
Jenny

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Habe eine Spalte helöscht / Problem mit Makro"