Erste freie Zelle wird nur einmal ausgewählt

Forumthread: Erste freie Zelle wird nur einmal ausgewählt

28.08.2017 09:00:39

Roman

Hallo Community,
ich will dass das Makro auf meinem Sheet immer zur ersten freien Zelle in der Spalte B springt. Das Makro an sich ist mit einer Schleife versehen. Das Problem ist, dass das Makro beim ersten mal funktioniert und etwas in die erste freie Zelle einfügt, jedoch wird das eingefügte immer überschrieben und das Makro springt nicht mehr in die nächste freie Zelle (also im 2. Durchgang unter das eingefügte, ich will es aneinanderreihen). Kann mir jemand helfen ?
Hier der Code dazu:


Sub Makro_Modulerstellung()
Dim i As Integer
i = 2
For i = 2 To 50
Sheets("Modulbenennung").Select
If Cells(i, 2).Value = "AS-P" Then
Sheets("Module").Select
Range("B1:AI4").Select
Selection.Copy
Sheets("ASP-OHM0_V99 (2)").Select
Cells(Range("B1").End(xlUp).Row + 8, 2).Select
ActiveSheet.Paste
ElseIf Cells(i, 2).Value = "PS-24" Then
Sheets("Module").Select
Range("B6:AI9").Select
Selection.Copy
Sheets("ASP-OHM0_V99 (2)").Select
Cells(Range("B1").End(xlUp).Row + 8, 2).Select
ActiveSheet.Paste
ElseIf Cells(i, 2).Value = "DO-FA-12-H" Then
Sheets("Module").Select
Range("B11:AI23").Select
Selection.Copy
Sheets("ASP-OHM0_V99 (2)").Select
Cells(Range("B1").End(xlUp).Row + 8, 2).Select
ActiveSheet.Paste
ElseIf Cells(i, 2).Value = "DO-FC-8-H" Then
Sheets("Module").Select
Range("B25:AI33").Select
Selection.Copy
Sheets("ASP-OHM0_V99 (2)").Select
Cells(Range("B1").End(xlUp).Row + 8, 2).Select
ActiveSheet.Paste
ElseIf Cells(i, 2).Value = "AO-V-8-H" Then
Sheets("Module").Select
Range("B35:AI43").Select
Selection.Copy
Sheets("ASP-OHM0_V99 (2)").Select
Cells(Range("B1").End(xlUp).Row + 8, 2).Select
ActiveSheet.Paste
ElseIf Cells(i, 2).Value = "AO-8-H" Then
Sheets("Module").Select
Range("B45:AI53").Select
Selection.Copy
Sheets("ASP-OHM0_V99 (2)").Select
Cells(Range("B1").End(xlUp).Row + 8, 2).Select
ActiveSheet.Paste
ElseIf Cells(i, 2).Value = "DI-16" Then
Sheets("Module").Select
Range("B55:AI71").Select
Selection.Copy
Sheets("ASP-OHM0_V99 (2)").Select
Cells(Range("B1").End(xlUp).Row + 8, 2).Select
ActiveSheet.Paste
ElseIf Cells(i, 2).Value = "RTD-DI-16" Then
Sheets("Module").Select
Range("B73:AI89").Select
Selection.Copy
Sheets("ASP-OHM0_V99 (2)").Select
Cells(Range("B1").End(xlUp).Row + 8, 2).Select
ActiveSheet.Paste
ElseIf Cells(i, 2).Value = "UI-8.AO-4-H" Then
Sheets("Module").Select
Range("B91:AI103").Select
Selection.Copy
Sheets("ASP-OHM0_V99 (2)").Select
Cells(Range("B1").End(xlUp).Row + 8, 2).Select
ActiveSheet.Paste
ElseIf Cells(i, 2).Value = "UI-8.DO-FC-4-H" Then
Sheets("Module").Select
Range("B105:AI117").Select
Selection.Copy
Sheets("ASP-OHM0_V99 (2)").Select
Cells(Range("B1").End(xlUp).Row + 8, 2).Select
ActiveSheet.Paste
ElseIf Cells(i, 2).Value = "UI-16" Then
Sheets("Module").Select
Range("B119:AI135").Select
Selection.Copy
Sheets("ASP-OHM0_V99 (2)").Select
Cells(Range("B1").End(xlUp).Row + 8, 2).Select
ActiveSheet.Paste
End If
Next i
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Erste freie Zelle wird nur einmal ausgewählt

28.08.2017 09:48:56

yummi

Hallo Roman,
ohne deinen Code komplett umzubauen (Select brauchst Du nicht) und Du schreibst in jedem Zweig im Prinzip das gleiche.
letzteZeile als long definieren
Ersetzte mal jeweils


Cells(Range("B1").End(xlUp).Row + 8, 2).Select

durch


letztezeile = Sheets("ASP-OHM0_V99 (2)").Cells(Rows.Count, 2).End(xlUp).Row + 8
Cells(letztezeile, 2).Select

Gruß
yummi

AW: Erste freie Zelle wird nur einmal ausgewählt

28.08.2017 09:56:44

Roman

Hallo yummi,
konnte das Problem feststellen und beheben. Trotzdem danke für deine Hilfe !
Grüße Roman

AW: Erste freie Zelle wird nur einmal ausgewählt

28.08.2017 09:53:59

ChrisL

Hi Roman
In Ergänzung hier ein Vorschlag wie du den Code strukturieren könntest. Das Zusammenspiel der 3 Blätter konnte ich nur erahnen:

Sub t()
Dim WS1 As Worksheet: Set WS1 = Worksheets("Modulbenennung")
Dim WS2 As Worksheet: Set WS2 = Worksheets("Module")
Dim WS3 As Worksheet: Set WS3 = Worksheets("ASP-OHM0_V99 (2)")
Dim i As Integer
For i = 1 To 50
Select Case WS1.Cells(i, 2)
Case "AS-P": WS2.Range("B1:AI4").Copy WS3.Cells(Rows.Count, 2).End(xlUp).Offset(8, 0)
Case "PS-24": WS2.Range("B6:AI9").Copy WS3.Cells(Rows.Count, 2).End(xlUp).Offset(8, 0)
'usw.
End Select
Next i
End Sub

cu
Chris

Beliebteste Forumthreads (12 Monate)

Erste freie Zelle wird nur einmal ausgewählt

Forumthread: Erste freie Zelle wird nur einmal ausgewählt

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread