Collapse column

Autor Thema: Office 2013: [EXCEL][VBA] Zeilen unter Voraussetzung kopieren  (Gelesen 410 mal)

Offline Ultrafear

  • Newbie
  • *
  • Beiträge: 1
    • Profil anzeigen
  • Office-KnowHow: Fortgeschritten
  • VBA-KnowHow- : Mittelmäßig
  • Version [Office] : Office 2013
Office 2013: [EXCEL][VBA] Zeilen unter Voraussetzung kopieren
« am: August 14, 2017, 12:53:34 Nachmittag »
Hallo Zusammen  :D,

ich habe folgendes Problem:
Ich möchte gern über eine Schaltfläche alle Zeilen von Tabellenblatt1 auf Tabellenblatt2 kopieren wo in Spalte A ein "X" steht. Wird die Schaltfläche ein weiteres Mal betätigt, soll die gleiche Aktion erneut ausgeführt werden. Jedoch diesmal alle Werte darunter platziert werden.

Ich habe schon einiges an Code mir zusammenstückeln können:

Sub NurMitInhaltKopieren()
'Nur Zellen mit "X" in Spalte A auf anderes Blatt kopieren
   Dim lRowSrc As Long, fFreeDst As Long
   Dim lColSrc As Integer
   Dim wksSrc As Worksheet, wksDst As Worksheet
   Dim ZeSrc As Long, ZeDst As Long
   Dim rngZe As Range
     
   With ActiveWorkbook
      Set wksSrc = .Sheets("Tabelle1")
      Set wksDst = .Sheets("Tabelle2")
   End With
   With wksSrc
      lRowSrc = .Cells.Find(What:="*", SearchOrder:=xlByRows, _
       SearchDirection:=xlPrevious).Row
      lColSrc = .Cells.Find(What:="*", SearchOrder:=xlByColumns, _
       SearchDirection:=xlPrevious).Column
   End With
   With wksDst
      If WorksheetFunction.CountA(.Cells) = 0 Then
         fFreeDst = 1
      Else
         fFreeDst = .Cells.Find(What:="*", SearchOrder:=xlByRows, _
          SearchDirection:=xlPrevious).Row + 1
      End If
   End With
   On Error GoTo ErrorHandler
   With wksSrc
      For ZeSrc = 1 To lRowSrc
         Set rngZe = .Range(.Cells(ZeSrc, 1), .Cells(ZeSrc, lColSrc))
         If WorksheetFunction.CountA(rngZe) > 0 Then
            rngZe.Copy wksDst.Cells(fFreeDst, 1)
            fFreeDst = fFreeDst + 1
         End If
      Next ZeSrc
   End With
ErrorHandler:
   If Err.Number <> 0 Then
      MsgBox "Fehler Nummer: " & Err.Number & vbCrLf _
       & "Fehler: " & Err.Description
   End If
End Sub

Jetzt habe ich das Problem, dass alle Zellen mit Inhalt kopiert werden und es nicht auf Spalte A "X" limitiert ist.

Könnte mir vielleicht einer von Euch erklären wie ich das ganze umzusetzen habe? Ich glaube es liegt am:

"What:="*"
welches ich durch eine Art:

If .Cells(Zeile, 1).Value = "X" Then
ersetzen müsste. Jedoch weiß ich leider nicht wie. 


Gruß

Muzel


PS:

Begonnen hatte ich mit:

Sub Copy()

Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long

With Tabelle1
ZeileMax = .UsedRange.Rows.Count
n = 1

For Zeile = 2 To ZeileMax

If .Cells(Zeile, 1).Value = "X" Then

.Rows(Zeile).Copy Destination:=Tabelle2.Rows(n)
n = n + 1

End If
Next Zeile
End With

End Sub

Jedoch fehlte hier die Funktionalität nur die Werte zu kopieren und diese untereinender einzufügen.

Keine Lösung gefunden? Du kannst Dich gerne an unser erfahrenes Experten-Team wenden und Dein Anliegen in Auftrag geben.
>>> Schnell und einfach ein unverbindliches Angebot anfordern. Per E-Mail an anfrage@excel-inside.de oder per Online-Formular
<<<

!!! Wichtige Information
!!! Dieses Forum steht aus technischen Gründen ab dem 11. September 2019 nur noch im Lesemodus zur Verfügung.
Das NEUE Office-Fragen-Forum kannst du aber unter der gewohnten Domain https://office-fragen.de wie gewohnt nutzen.

- Wir freuen uns auf deinen Besuch im neuen Forum.