Zellen aus Bereich in erste leere Zelle

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub In_erster_leerer_Zelle_einfügen() Dim Text1 As String Dim Text2 As String Dim Text3 As String Dim Text4 As String Dim Text5 As String Dim Text6 As String Dim Text7 As String Dim Text8 As String Dim Text9 As String Dim Text10 As String Dim LastR As Long Text1 = Worksheets(2).Range("A2").Value Text2 = Worksheets(2).Range("A3").Value Text3 = Worksheets(2).Range("A4").Value Text4 = Worksheets(2).Range("A5").Value Text5 = Worksheets(2).Range("A6").Value Text6 = Worksheets(2).Range("A7").Value Text7 = Worksheets(2).Range("A8").Value Text8 = Worksheets(2).Range("A9").Value Text9 = Worksheets(2).Range("A10").Value Sheets(1).Select Cells.Find(What:="F", After:=ActiveCell).Activate LastR = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row + 1 Worksheets(1).Cells(LastR, ActiveCell.Column) = Text1 LastR = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row + 1 Worksheets(1).Cells(LastR, ActiveCell.Column) = Text2 LastR = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row + 1 Worksheets(1).Cells(LastR, ActiveCell.Column) = Text3 LastR = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row + 1 Worksheets(1).Cells(LastR, ActiveCell.Column) = Text4 LastR = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row + 1 Worksheets(1).Cells(LastR, ActiveCell.Column) = Text5 LastR = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row + 1 Worksheets(1).Cells(LastR, ActiveCell.Column) = Text6 LastR = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row + 1 Worksheets(1).Cells(LastR, ActiveCell.Column) = Text7 LastR = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row + 1 Worksheets(1).Cells(LastR, ActiveCell.Column) = Text8 LastR = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row + 1 Worksheets(1).Cells(LastR, ActiveCell.Column) = Text9 LastR = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row + 1 Worksheets(1).Cells(LastR, ActiveCell.Column) = Text10 End Sub

Sub Makro() Dim s As Integer Dim z As Integer s = 1 'ermittelt, in welcher Spalte "F" steht Do If Worksheets(1).Cells(1, s).Value = "F" Then Exit Do Else s = s + 1 End If Loop Until Worksheets(1).Cells(1, s).Value = "" 'bricht die Routine ab, wenn kein F gefunden wurde If Worksheets(1).Cells(1, s) = "" Then MsgBox "Kein F gefunden" Exit Sub Else End If 'ermittelt erste leere Zelle in der F-Spalte If Worksheets(1).Cells(2, s) = "" Then z = 2 Else z = Worksheets(1).Cells(1, s).End(xlDown).Row + 1 End If 'trägt die Werte ein, wenn vorhanden If Worksheets(2).Cells(2, 1) = "" Then MsgBox "In Tabelle2 Spalte A sind keine Daten vorhanden" Exit Sub Else For i = 2 To Worksheets(2).Cells(1.1).End(xlDown).Row Worksheets(1).Cells(z, s).Value = Worksheets(2).Cells(i, 1).Value z = z + 1 Next i End If End Sub

Hallo Edmund,
ich habe meine Eingabemaske in Tabelle2 nun etwas geändert.
Nun fangen die Werte, die ich in die erste leere Zelle kopieren möchte, erst in Tabelle2 "U19" an.
Ich habe den Code versucht, wie folgt anzupassen:

Sub Makro2()
Dim s As Integer
Dim z As Integer
Dim i As Integer
s = 1
'ermittelt, in welcher Spalte "F" steht
Do
If Worksheets(1).Cells(1, s).Value = "F" Then
Exit Do
Else
s = s + 1
End If
Loop Until Worksheets(1).Cells(1, s).Value = ""
'bricht die Routine ab, wenn kein F gefunden wurde
If Worksheets(1).Cells(1, s) = "" Then
MsgBox "Kein F gefunden"
Exit Sub
Else
End If
'ermittelt erste leere Zelle in der F-Spalte
If Worksheets(1).Cells(2, s) = "" Then
z = 2
Else
z = Worksheets(1).Cells(1, s).End(xlDown).Row + 1
End If
'trägt die Werte ein, wenn vorhanden
If Worksheets(2).Cells(19, 21) = "" Then
MsgBox "In Tabelle2 Spalte U19 sind keine Daten vorhanden"
Exit Sub
Else
For i = 2 To Worksheets(2).Cells(1.1).End(xlDown).Row
Worksheets(1).Cells(z, s).Value = Worksheets(2).Cells(i, 21).Value
z = z + 1
Next i
End If
End Sub

In Zelle Z18 würde ich dann die Anzahl der Wiederholungen eintragen.
Außerdem füge ich hinter die letzte ausgefüllte Spalte noch mehrere weitere Spalten ein.
Dies habe ich wie folgt gelöst, vielleicht gibt es hier auch noch eine flexiblere Lösung?

    Dim Column1 As String
Dim Column2 As String
Dim Column3 As String
Dim Column4 As String
Dim Column5 As String
Column1 = Worksheets("Senden").Range("T6").Value
Column2 = Worksheets("Senden").Range("T7").Value
Column3 = Worksheets("Senden").Range("T8").Value
Column4 = Worksheets("Senden").Range("T9").Value
Column5 = Worksheets("Senden").Range("T9").Value
LastS = Worksheets("Import").Cells(1, 256).End(xlToLeft).Column + 1
Worksheets("Import").Cells(1, LastS) = Column1
LastS = Worksheets("Import").Cells(1, 256).End(xlToLeft).Column + 1
Worksheets("Import").Cells(1, LastS) = Column2
LastS = Worksheets("Import").Cells(1, 256).End(xlToLeft).Column + 1
Worksheets("Import").Cells(1, LastS) = Column3
LastS = Worksheets("Import").Cells(1, 256).End(xlToLeft).Column + 1
Worksheets("Import").Cells(1, LastS) = Column4
LastS = Worksheets("Import").Cells(1, 256).End(xlToLeft).Column + 1
Worksheets("Import").Cells(1, LastS) = Column5

Beliebteste Forumthreads (12 Monate)

Zellen aus Bereich in erste leere Zelle

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen aus Bereich in erste leere Zelle

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread