Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Werte prüfen und kopieren

Gruppe

Kopieren

Problem

Ist eine Artikelnummer in Spalte A noch nicht vorhanden, soll die nächsthöhere Zahl als Artikelnummer eingesetzt und der Wertebereich der Zeile in das Blatt "Ziel" kopiert werden.

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: basMain

Sub MatchCopy()
   Dim var As Variant
   Dim lRowL As Integer, lRow As Integer, lRowD, lRowS As Long
   Dim bln As Boolean
   lRowL = Cells(Rows.Count, 2).End(xlUp).Row
   For lRow = 1 To lRowL
      bln = False
      If Not IsEmpty(Cells(lRow, 1)) Then
         var = Application.Match(Cells(lRow, 1), _
            Worksheets("Ziel").Columns("A"), 0)
      Else
         Cells(lRow, 1).Value = WorksheetFunction.Max(Columns(1)) + 1
         bln = True
      End If
      If IsError(var) Or bln = True Then
         With Worksheets("Ziel")
            If IsEmpty(.Cells(1, 1)) Then
               lRowS = 1
            Else
               lRowS = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
            .Range(.Cells(lRowS, 1), .Cells(lRowS, 4)).Value = _
               Range(Cells(lRow, 1), Cells(lRow, 4)).Value
         End With
      Else
         With Worksheets("Vorhanden")
            If IsEmpty(.Cells(1, 1)) Then
               lRowD = 1
            Else
               lRowD = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
            .Range(.Cells(lRowD, 1), .Cells(lRowD, 4)).Value = _
               Range(Cells(lRow, 1), Cells(lRow, 4)).Value
         End With
      End If
   Next lRow
End Sub