VBA - Datenübernahme nach Prüfung auf Leere, oder nicht leere Zelle

[Liveplay]

Hallo zusammen,

ich habe mir jetzt schon mehrfache Tutorials angesehen und komme trotzdem nicht weiter. Ich möchte aus einem Arbeitsblatt Daten in ein anderes übernehmen. Dabei würde ich mehrfach mit verschiedenen Auswahlen arbeiten. Hierbei muss aber im Arbeitsblatt, wo die Daten aus dem ursprünglichen Arbeitsblatt kommt, geprüft werden ob bereits Daten vorhanden sind und wenn Ja, soll die Daten unten angehängt werden.

Soweit so gut. Im Test mit folgenden Code habe ich bereits herausgefunden wie ich prüfen kann ob die Spalte leere ist und wenn nicht das die Selektion nach unten geht und dort eingefügt wird. Funktioniert aber dann mit meinen Daten bzw. der Selektion nicht. Was mache ich falsch?

Code:

If Not Range("B1").Value = "" Then
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveCell = "Banana"
End If


If Range("B1").Value = "" Then
Range("B1").Select
ActiveCell = "Apfel"
End If

Oben zu sehen mein Test. Ich prüfe ob die Zelle B1 nicht Leer ist. Wenn dem so ist, soll das Wort Banana angefügt werden (^^). Im nächsten Schritt prüfe ich ob B1 Leer ist und füge Apfel in die Zeile an. Nun zum Beispiel mit meinen Daten:

Code:

Sub HR_to_KAPA()

    If Range("B1").Value = "" Then
    '--------------------------------------------------------------------------
    Sheets("HR").Select
    '--------------------------------------------------------------------------
    Range("D5:D9").Select
    Selection.Copy
    Sheets("PEM Upload").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    If Not Range("B1").Value = "" Then
    '--------------------------------------------------------------------------
    Sheets("HR").Select
    '--------------------------------------------------------------------------
    Range("D5:D9").Select
    Selection.Copy
    Sheets("PEM Upload").Select
    Range("B" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    '--------------------------------------------------------------------------

End Sub

Warum auch immer wird bei dem Code die Auswahl aus dem ursprünglichen Arbeitsblatt wild im neuen verteilt bzw. landet die kopierte Selektion bspw. in Spalte H, Zeile 15. Ich kann mir das nicht erklären.

[Kuwer]

Hallo,

die Zelle B1 wurde nicht selektiert, wenn sie leer ist.

Code:

Sub HR_to_KAPA()
    If Range("B1").Value = "" Then
      '--------------------------------------------------------------------------
      Sheets("HR").Select
      '--------------------------------------------------------------------------
      Range("D5:D9").Select
      Selection.Copy
      Sheets("PEM Upload").Select
      Range("B1").Select  '<<< Diese Anweisung fehlte
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
    Else
      '--------------------------------------------------------------------------
      Sheets("HR").Select
      '--------------------------------------------------------------------------
      Range("D5:D9").Select
      Selection.Copy
      Sheets("PEM Upload").Select
      Range("B" & Rows.Count).End(xlUp).Offset(1).Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
    End If
    '--------------------------------------------------------------------------
End Sub

Ohne überflüssige Selects geht es z.B. so:

Code:

Sub HR_to_KAPA_Einfacher_Ohne_Selects()
    Sheets("HR").Range("D5:D9").Copy
    With Sheets("PEM Upload").Range("B" & Rows.Count).End(xlUp)
      .Offset(-(.Value <> "")).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
End Sub

[Liveplay]

Vielen lieben Dank. Mir fehlen noch zu viele VBA Kenntnisse um auf eine solche Lösung zu kommen (^^).

Eine Frage habe ich da aber noch, kann man in deine Lösung auch die Sortierung einbauen?

Der Bereich Range D5:D9 kopiert IDs, die bspw. mit 02, 03, 06 usw. anfangen. Diese müssen bestenfalls von klein- nach groß sortiert werden beim Kopiervorgang. Jedoch müssen dazu dann auch, genau der Tabellen-Sortierung von A-Z die benachbarten Bereiche passend sortiert werden. Das Sortierkriterium ist dabei Spalte B.

Per Hand könnte ich die jeweiligen Bereiche markieren und das benutzerdefinierte Sortieren anwenden, ich würde mir aber eine automatisierte Möglichkeit wünschen. Da das Tabellenblatt im Anschluss als neue Arbeitsmappe im CSV Format automatisch gespeichert werden soll.