VBA Tab1 Zeilen kopieren und in Tab2 einfügen

Hallo Forum,
ich komme einfach nicht weiter.
Es sollen die Inhalte (Value) von Tab1 N110:U130 in Tab2 Spalte AA..:AN.. (Zeilen in gelb) eingefügt werden.
Es soll also in Tab1 Zelle N110 und Zelle O110 geguckt werden ob Zellen belegt sind.
Wenn beide Zellen belegt, dann soll Tab1 Zeile N110 bis U110 kopiert werden (nur Value) und in Tab2 ab Spalte AA.. bzw. Spalte AB.. (wenn beide Zelle leer) eingefügt werden. Sonst in Tab2 eine Zeile tiefer eingefügt werden (letzte befüllte Zelle von Spalte AA.. und AB..).
Es kann sein, daß einige Zeilen von Tab2 ausgeblendet werden. Die eingefügten Inhalte sollen am Ende zu sehen sein.
Hoffentlich kann man hier eine passende Lösung finden.
Vielen Dank und Gruß
mehmet

Die Datei https://www.herber.de/bbs/user/93354.xls wurde aus Datenschutzgründen gelöscht

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub t19b_Status() ' unten anhaengen 'Sheets Tab1 Sheets Tab2 'N110:N130 AA Spalte 27 'O110:O130 AB Spalte 28 'P110:P130 AC Spalte 29 'Q110:Q130 AD Splate 30 'R110:R130 AG Spalte 33 'S110:S130 AJ Spalte 36 'T110:T130 AK Spalte 37 'U110:U130 AN Spalte 40 Sheets("Tab2").Select: Range("AB19").Select Dim xx As Variant xx = ActiveSheet.Cells(Rows.Count, 27).End(xlUp).Row + 1 For Each xx In Selection If xx.EntireRow.Hidden = True Then '110 muss noch laufvariable sein Sheets("Tab2").Cells(xx, 27).Value = Sheets("Tab1").Cells(110, 14).Value Sheets("Tab2").Cells(xx, 28).Value = Sheets("Tab1").Cells(110, 15).Value Sheets("Tab2").Cells(xx, 29).Value = Sheets("Tab1").Cells(110, 16).Value Sheets("Tab2").Cells(xx, 30).Value = Sheets("Tab1").Cells(110, 17).Value Sheets("Tab2").Cells(xx, 33).Value = Sheets("Tab1").Cells(110, 18).Value Sheets("Tab2").Cells(xx, 36).Value = Sheets("Tab1").Cells(110, 19).Value Sheets("Tab2").Cells(xx, 37).Value = Sheets("Tab1").Cells(110, 20).Value Sheets("Tab2").Cells(xx, 40).Value = Sheets("Tab1").Cells(110, 21).Value End If Next xx End Sub

Private Sub t19b_Status() Dim xx As Variant, Zelle As Range, Wks1 As Worksheet, Wks2 As Worksheet, i, j Set Wks1 = Tabelle1 Set Wks2 = Tabelle2 Wks1.Select xx = Wks2.Cells(Rows.Count, 27).End(xlUp).Row + 1 For Each Zelle In Wks1.Range("N110:N130") j = 14 If Wks2.Cells(xx, 1).EntireRow.Hidden = True Then For i = 27 To 40 Select Case i Case Is = 27, 28, 29, 30, 33, 36, 37, 40 Wks2.Cells(xx, i).Value = Wks1.Cells(Zelle.Row, j).Value j = j + 1 End Select Next xx = xx + 1 End If Next Set Wks1 = Nothing Set Wks2 = Nothing End Sub

Private Sub t19b_Status() Dim i As Integer For i = 110 To 130 'suche Spalten Tab1 N:U If Sheets("Tab1").Cells(i, 14) <> "" And Sheets("Tab1").Cells(i, 15) <> "" Then 'Zeile 110 a = Sheets("Tab2").Cells(Rows.Count, 27).End(xlUp).Row + 1 '27 Spalte AA Sheets("Tab2").Cells(a, 27).Value = Sheets("Tab1").Cells(i, 14).Value Sheets("Tab2").Cells(a, 28).Value = Sheets("Tab1").Cells(i, 15).Value Sheets("Tab2").Cells(a, 29).Value = Sheets("Tab1").Cells(i, 16).Value Sheets("Tab2").Cells(a, 30).Value = Sheets("Tab1").Cells(i, 17).Value Sheets("Tab2").Cells(a, 33).Value = Sheets("Tab1").Cells(i, 18).Value Sheets("Tab2").Cells(a, 36).Value = Sheets("Tab1").Cells(i, 19).Value Sheets("Tab2").Cells(a, 37).Value = Sheets("Tab1").Cells(i, 20).Value Sheets("Tab2").Cells(a, 40).Value = Sheets("Tab1").Cells(i, 21).Value End If Next i End Sub

Private Sub t19b_Status() Dim i As Integer, a As Long For i = 110 To 130 'Suchen in den Zeilen 110 - 130 If Tabelle1.Cells(i, 14) <> "" And Tabelle1.Cells(i, 15) <> "" Then With Tabelle2 a = .Cells(Rows.Count, 27).End(xlUp).Row + 1 '27 Spalte AA .Cells(a, 27).Value = Tabelle1.Cells(i, 14).Value 'Kopieren der Spalten N:U .Cells(a, 28).Value = Tabelle1.Cells(i, 15).Value 'nach Tabelle2 Spalten 27 - 40 .Cells(a, 29).Value = Tabelle1.Cells(i, 16).Value .Cells(a, 30).Value = Tabelle1.Cells(i, 17).Value .Cells(a, 33).Value = Tabelle1.Cells(i, 18).Value .Cells(a, 36).Value = Tabelle1.Cells(i, 19).Value .Cells(a, 37).Value = Tabelle1.Cells(i, 20).Value .Cells(a, 40).Value = Tabelle1.Cells(i, 21).Value End With End If Next i End Sub

Hallo Gerold,
vielen Dank fuer dein Tip. Werd ich machen.
Ich habe versucht dein Makro mit vielen Moeglichkeiten anzupassen bzgl. Hide:
Hier ein Beispiel:

Private Sub t19b_Status()
Dim i As Integer, a As Long
b = Tabelle2.Cells(Rows.Count, 27).End(xlUp).Row '27 Spalte AA
For i = 110 To 130                                              'Suchen in den Zeilen 110 - 130
For b = 99 To 1
If Tabelle1.Cells(i, 14) <> "" And Tabelle1.Cells(i, 15) <> "" Then
If Tabelle2.Rows(b).EntireRow.Hidden = True Then 'So wird z.b. nur die Zeile 1  _
ausgeblendet
b = b + 1
With Tabelle2
a = .Cells(Rows.Count, 27).End(xlUp).Row + 1          '27 Spalte AA
.Cells(a, 27).Value = Tabelle1.Cells(i, 14).Value 'Kopieren der Spalten N:U
.Cells(a, 28).Value = Tabelle1.Cells(i, 15).Value   'nach Tabelle2 Spalten 27 - 40
.Cells(a, 29).Value = Tabelle1.Cells(i, 16).Value
.Cells(a, 30).Value = Tabelle1.Cells(i, 17).Value
.Cells(a, 33).Value = Tabelle1.Cells(i, 18).Value
.Cells(a, 36).Value = Tabelle1.Cells(i, 19).Value
.Cells(a, 37).Value = Tabelle1.Cells(i, 20).Value
.Cells(a, 40).Value = Tabelle1.Cells(i, 21).Value
End With
Else
With Tabelle2
a = .Cells(Rows.Count, 27).End(xlUp).Row + 1          '27 Spalte AA
.Cells(a, 27).Value = Tabelle1.Cells(i, 14).Value 'Kopieren der Spalten N:U
.Cells(a, 28).Value = Tabelle1.Cells(i, 15).Value   'nach Tabelle2 Spalten 27 - 40
.Cells(a, 29).Value = Tabelle1.Cells(i, 16).Value
.Cells(a, 30).Value = Tabelle1.Cells(i, 17).Value
.Cells(a, 33).Value = Tabelle1.Cells(i, 18).Value
.Cells(a, 36).Value = Tabelle1.Cells(i, 19).Value
.Cells(a, 37).Value = Tabelle1.Cells(i, 20).Value
.Cells(a, 40).Value = Tabelle1.Cells(i, 21).Value
End With
End If
End If
Next b
Next i
End Sub

Das Makro macht einfach nicht was ich will 8-)
Egal ob ich in Tab2 Zeilen 9-20 ausblende oder alle Zeilen einblende.
Hab ich die "b" Variable falls gemacht oder die "hide" abfrage falsch angesetzt?
https://www.herber.de/bbs/user/93382.xls
Viele Gruesse
mehmet

Private Sub t19b_Status() Dim i As Integer, a As Long 'Würde erst mal alle Zeilen einblenden damit die letzte Zeile richtig erkannt wird Tabelle2.Cells.EntireRow.Hidden = False 'Daten Kopieren For i = 110 To 130 If Tabelle1.Cells(i, 14) <> "" And Tabelle1.Cells(i, 15) <> "" Then With Tabelle2 a = .Cells(Rows.Count, 27).End(xlUp).Row + 1 '27 Spalte AA .Cells(a, 27).Value = Tabelle1.Cells(i, 14).Value 'Kopieren der Spalten N:U .Cells(a, 28).Value = Tabelle1.Cells(i, 15).Value 'nach Tabelle2 Spalten 27 - 40 .Cells(a, 29).Value = Tabelle1.Cells(i, 16).Value .Cells(a, 30).Value = Tabelle1.Cells(i, 17).Value .Cells(a, 33).Value = Tabelle1.Cells(i, 18).Value .Cells(a, 36).Value = Tabelle1.Cells(i, 19).Value .Cells(a, 37).Value = Tabelle1.Cells(i, 20).Value .Cells(a, 40).Value = Tabelle1.Cells(i, 21).Value End With End If Next i 'Zeilen ausblenden zB.Zeilen 5-11 For a = 5 To 11 Tabelle2.Rows(a).EntireRow.Hidden = True Next End Sub

Private Sub t19b_Status() Dim i As Integer, a As Long, Zähler As Long 'Würde erst mal alle Zeile einblenden damit die letzte Zeile richtig erkannt wird Tabelle2.Cells.EntireRow.Hidden = False Zähler = 3 'Daten Kopieren For i = 110 To 130 If Tabelle1.Cells(i, 14) <> "" And Tabelle1.Cells(i, 15) <> "" Then With Tabelle2 a = .Cells(Rows.Count, 27).End(xlUp).Row + 1 '27 Spalte AA .Cells(a, 27).Value = Tabelle1.Cells(i, 14).Value 'Kopieren der Spalten N:U .Cells(a, 28).Value = Tabelle1.Cells(i, 15).Value 'nach Tabelle2 Spalten 27 - 40 .Cells(a, 29).Value = Tabelle1.Cells(i, 16).Value .Cells(a, 30).Value = Tabelle1.Cells(i, 17).Value .Cells(a, 33).Value = Tabelle1.Cells(i, 18).Value .Cells(a, 36).Value = Tabelle1.Cells(i, 19).Value .Cells(a, 37).Value = Tabelle1.Cells(i, 20).Value .Cells(a, 40).Value = Tabelle1.Cells(i, 21).Value Zähler = Zähler + 1 End With End If Next i 'Zeilen Ausblenden '3 alte + die neuen sind eingeblendet Tabelle2.Range("A2:A" & (a - (Zähler))).EntireRow.Hidden = True End Sub

Private Sub t19b_Status() Dim i As Integer, a As Long, ZZähler As Long, ZlAus() 'Einlesen welche Zeile ausgeblendet ist For ZZähler = 1 To Rows.Count ReDim Preserve ZlAus(1 To ZZähler) If Tabelle2.Cells(ZZähler, 27).Value = "" Then Exit For ZlAus(ZZähler) = Tabelle2.Cells(ZZähler, 1).EntireRow.Hidden Next 'Würde erst mal alle Zeile einblenden damit die letzte Zeile richtig erkannt wird Tabelle2.Cells.EntireRow.Hidden = False 'Daten Kopieren For i = 110 To 130 If Tabelle1.Cells(i, 14) <> "" And Tabelle1.Cells(i, 15) <> "" Then With Tabelle2 a = .Cells(Rows.Count, 27).End(xlUp).Row + 1 '27 Spalte AA .Cells(a, 27).Value = Tabelle1.Cells(i, 14).Value 'Kopieren der Spalten N:U .Cells(a, 28).Value = Tabelle1.Cells(i, 15).Value 'nach Tabelle2 Spalten 27 - 40 .Cells(a, 29).Value = Tabelle1.Cells(i, 16).Value .Cells(a, 30).Value = Tabelle1.Cells(i, 17).Value .Cells(a, 33).Value = Tabelle1.Cells(i, 18).Value .Cells(a, 36).Value = Tabelle1.Cells(i, 19).Value .Cells(a, 37).Value = Tabelle1.Cells(i, 20).Value .Cells(a, 40).Value = Tabelle1.Cells(i, 21).Value End With End If Next i 'Oben eingelesene Zeilen wieder ausblenden For i = 1 To ZZähler Tabelle2.Cells(i, 1).EntireRow.Hidden = ZlAus(i) Next End Sub

Private Sub t19b_Status() Dim i As Integer, a As Long, ZZähler As Long, ZlAus() Application.ScreenUpdating = False 'Diese Zeile einfügen Application.Calculation = xlCalculationManual 'Diese Zeile einfügen 'Einlesen welche Zeile ausgeblendet ist Next Application.Calculation = xlCalculationAutomatic 'Diese Zeile einfügen Application.ScreenUpdating = True 'Diese Zeile einfügen End Sub

Beliebteste Forumthreads (12 Monate)

VBA Tab1 Zeilen kopieren und in Tab2 einfügen

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

429 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Tab1 Zeilen kopieren und in Tab2 einfügen

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

429 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread