Office: Makro, das aus definiertem Bereich nur den "gefüllten" Bereich kopiert

Hallo,

ich habe mir ein Makro gebaut, das einen Zellbereich kopiert (Tabelle Original) und dann an das Ende einer anderen Tabelle (Datenbank) anfügt. Der Zellbereich besteht aus mehreren Zeilen, die jeweils ein Angebot umfassen.

Ich möchte nun sicherstellen, dass keine leeren Zeilen bzw. Falscheingaben, aus dem zu kopierenden Bereich, in die Datenbanktabelle übertragen werden.

Der zu kopierende Bereich ist B15:L22, eine Datenzeile geht daher von 15 bis 22. Sobald kein Wert mehr in der Spalte F z.B. F16 eingetragen ist, soll nur noch der darüber liegende Bereich kopiert werden.

Es wäre schön, wenn mir jemand eine entsprechende VBA-Lösung zur Verfügung stellen könnte.

Vielen Dank!

JOscha

 

Hi Joscha,

ermittle zuerst die letzte belegte Zeile in Spalte F und mache dadurch den Kopierbereich variabel in Abhängigkeit des letzten Eintrags. Die letzte belegte Zeile in Spalte F kann man so ermitteln:

Code:

[TABLE="width: 80"]
<tbody>[TR]
[TD="width: 80"]    Dim lngLetzte As Long[/TD]
[/TR]
[TR]
[TD]    lngLetzte =IIf(IsEmpty(Cells(Rows.Count, 6)), Cells(Rows.Count,   6).End(xlUp).Row, Rows.Count)[/TD]
[/TR]
</tbody>[/TABLE]

Zum Kopieren verwendest du dann dieses:

Code:

Range("B15:L" & lngLetzte)

Bis später,
Karin

 

Hallo Karin,

vielen Dank für die schnelle Antwort und den Code.

Leider funktioniert es bei mir noch nicht ganz. Ich habe den Code in mein Makro ergänzt und noch den Kopierbefehl eingefügt.



Leider erscheint beim Ausführen des Makros zu dem Kopierbefehl immer die Meldung "Fehlermeldung beim Kompilieren". Kannst du dir das bitte noch einmal anschauen?

Vielen Dank!

Joscha

 

Hier noch mal das Makro als Text:

Sub Test()
'
' Test Makro
'

'
Range("B15:L22").Select

Dim lngLetzte As Long
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 6)), Cells(Rows.Count, 6).End(xlUp).Row, Rows.Count)

Range ("B15:L" & lngLetzte)
Selection.Copy

Worksheets("Transit").Activate
Z = 1
Do While Len(Worksheets("Transit").Cells(Z, 1)) > 0 'Ermitteln der Tabellenlänge
Z = Z + 1
Loop
Range("A" & Z).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

 

Ich schmeiß meinen Hut auch noch mit in den Ring...

Gruß, Michael

 

Hi Joscha,

Code:

Sub Test()
   Dim lngLetzte As Long
   lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 6)), Cells(Rows.Count, 6).End(xlUp).Row, Rows.Count)
   Range("B15:L" & lngLetzte).Copy
   With Worksheets("Transit")
      lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
      .Range("A" & lngLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
   End With
End Sub

Bis später,
Karin

 

Hallo Karin,
hallo Michael,

erneut vielen Dank für eure Hilfe.

Als vba-Anfänger wirkt die Lösung von Karin für mich vertrauter, daher möchte ich mich daran orientieren.

Das läuft jetzt schon ziemlich gut. Ich habe noch zwei Fragen:

Ich möchte explizit nur den Bereich B15:L22 kopieren, da darunter noch andere Informationen stehen, die ansonsten auch mitkopiert werden. Wenn ich diese Daten lösche läuft das Makro auch wunderbar. Wie kann ich den Bereich einschränken?

In der Tabelle in der die Daten eingefügt werden sollen, werden die Daten zur Zeit ab der letzten befüllten Zelle eingefügt. Sie sollten jedoch eine darunter eingefügt werden (erste Leere). Mit meiner alten Lösung bekomme ich das wieder hin, aber ich würde auch gerne sehen, wie das in deiner Lösung aussieht.

Noch einmal vielen Dank für deine Unterstützung.

Viele Grüße

Joscha

 

Hi Joscha,

Code:

Sub Test()
   Dim lngLetzte As Long
   lngLetzte = 14 + Range("F15:F22").SpecialCells(xlCellTypeConstants).Count
   Range("B15:L" & lngLetzte).Copy
   With Worksheets("Transit")
      lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
      .Range("A" & lngLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
   End With
End Sub

Bis später,
Karin

 

Danke, das sieht sehr gut aus!

 

Hallo Karin,

ich habe mit deiner Hilfe das obige Makro erarbeitet.

Ich habe das Makro noch erweitert, dass noch ein zweiter Bereich auf Befüllung überprüft wird und anschließend an eine andere Tabelle angehängt wird:

Sub Test()
'
' Test Makro
'
'
Dim lngLetzte As Long
lngLetzte = 14 + Range("F15:F22").SpecialCells(xlCellTypeConstants).Count
Workbooks.Open Filename:= _
"C:\Users\Joscha\Documents\_Studium\Index-Formel.xlsx", UpdateLinks:=3
With Worksheets("Marine")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
.Range("A" & lngLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveWorkbook.Save
ActiveWindow.Close

Dim lngLetzte1 As Long
lngLetzte1 = 29 + Range("C30:C37").SpecialCells(xlCellTypeConstants).Count
Range("B30:L" & lngLetzte1).Copy


Workbooks.Open Filename:= _
"C:\Users\Joscha\Documents\_Studium\Index-Formel.xlsx", UpdateLinks:=3
With Worksheets("Storage")
lngLetzte1 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
.Range("A" & lngLetzte1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveWorkbook.Save
ActiveWindow.Close


End With
End With
End Sub



Das Makro funktioniert auch soweit. Ich habe nun beim Testen bemerkt, dass sobald ein Wertebereich z.B. B30:37 keine zu kopierenden Zeilen enthält mir das Makro auf die Bretter geht (keine Zeilen vorhanden). Kann ich hier noch ein Funktion einbauen, dass sobald ein Bereich leer ist, dass Makro erst einmal nichts tut / leere Zeilen einfügt und die nächsten Schritten abhandelt.

Also wenn im oberen Bereich (B15:L22) nichts steht der Bereich (B30:L37) nichtsdestotrotz überprüft wird und umgekehrt?

Erneut danke für deine Hilfe!

Grüße

Joscha