Supportnet / Forum / Tabellenkalkulation

Hallo, ich brauch mal wieder Eure Hilfe. Habe eine Tabelle, wo Zeilen aus Tabelle 1 mit Hilfe eines Makros hinenkopiert werden. Das Problem ist, da immer unterschiedlich viele Zeilen in die Tabelle kopiert werden, habe ich auch unterschiedlich viele Seiten die ausgedruckt werden. Jetzt möchte ich drei Zeilen immer mit in die neue Tabelle kopieren, die aber erst auf der letzten Seite ganz unten auftauchen sollen. Ist das irgenwie machbar??? Es kann ja sein, das die letzte Seite nur zur Hälfte mit daten befüllt ist. Vielen Dank für Eure Hilfe!!! Gruß Elhamplo

Hallo,

letzteZeile = Range("A65536").End(xlUp).Row
letzteSpalte = Range("IV1").End(xlToLeft).Column

darüber kannst die letzte Spalte und Zeile ermitteln, hier in Spalte A bzw. Zeile 1

Gruß

Helmut

Hallo Elhamplo,

versuch es mal hiermit:

Option Explicit

Sub Seitenzahl()
Dim iSeiten As Integer, iUmbruch As Integer, loZeile As Long
iSeiten = ExecuteExcel4Macro("Get.Document(50)")
If iSeiten = 1 Then
MsgBox "Es ist nur eine Seite vorhanden!"
Else
iUmbruch = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64)," & iSeiten - 1 & ")")
loZeile = (iUmbruch - 1) + (iUmbruch - 1) / (iSeiten - 1)
Cells(loZeile, 1) = "letzte"
Cells(loZeile - 1, 1) = "vorletzte"
Cells(loZeile - 2, 1) = "die davor"
End If
End Sub

Der Code funktioniert allerdings nur, wenn alle Zellen die selbe Höhe haben.

Gruß

JöKe

Hallo,

ich danke Euch für Eure Hilfe!

Leider weiss ich nicht wie ich das hinbekomme immer die gleichen Zeilen aus Tabellenblatt 1 in das Zweite Tabellenblatt ans Ende der letzten Seite kopiert werden.

Hat jemand noch eine Idee???

Der Ursprungs Code kommt von Dir JöKe .

https://supportnet.de/threads/1416313

Vielen, vilen Dank!!!

Gruß

Elhamplo

Hallo Elhamplo,

das ist nicht so leicht zu machen, da die Seitenzahl von der Zeilenhöhe abhängig ist.
Folgender erweiterter Code ist für eine Zeilen von 10 Punkte ausgelegt.

Option Explicit


Sub Elhamplo()
Dim ws As Integer, i As Integer, Ziel As String, Quelle As String

Dim iSeiten As Integer, iUmbruch As Integer, loZeile As Long
Sheets(Sheets.Count).Select
iSeiten = ExecuteExcel4Macro("Get.Document(50)")
If iSeiten = 1 Then
loZeile = 56
GoTo Weiter
Else
iUmbruch = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64)," & iSeiten - 1 & ")")
loZeile = (iUmbruch - 1) + (iUmbruch - 1) / (iSeiten - 1)
Weiter:
Sheets("Tabelle1").Range("A3:G3").Copy _
Destination:=Sheets(Sheets.Count).Cells(loZeile, 1)
Sheets("Tabelle1").Range("A2:G2").Copy _
Destination:=Sheets(Sheets.Count).Cells(loZeile - 1, 1)
Sheets("Tabelle1").Range("A1:G1").Copy _
Destination:=Sheets(Sheets.Count).Cells(loZeile - 2, 1)
End If

Quelle = ActiveWorkbook.Name
Workbooks.Add
i = 1
For ws = 2 To Workbooks(Quelle).Worksheets.Count
Ziel = ActiveWorkbook.Name
Workbooks(Ziel).Sheets.Add after:=Worksheets(Worksheets.Count)
If Workbooks(Quelle).Sheets(ws).Range("C3") <> "" Then
Workbooks(Quelle).Sheets(ws).Cells.Copy _
Destination:=Workbooks(Ziel).Sheets(i).Range("a1")
i = i + 1
End If
Next
Application.ActivePrinter = "PDFCreator auf Ne02:"
Workbooks(Ziel).PrintOut Copies:=1, ActivePrinter:="PDFCreator auf Ne02:", _
Collate:=True
Application.DisplayAlerts = False
Workbooks(Ziel).Close
Application.DisplayAlerts = True
Sheets(Sheets.Count).Rows(loZeile & ":" & loZeile - 2) = ""
End Sub

Bei einer anderen Zeilenhöhe muss:

loZeile = 56

entsprchend angepasst werden.

Auch die Bereiche die in die letzte Zeile eingetragen werden sollen müssen angepasst werden.

Sheets("Tabelle1").Range("A3:G3").Copy _
Destination:=Sheets(Sheets.Count).Cells(loZeile, 1)
Sheets("Tabelle1").Range("A2:G2").Copy _
Destination:=Sheets(Sheets.Count).Cells(loZeile - 1, 1)
Sheets("Tabelle1").Range("A1:G1").Copy _
Destination:=Sheets(Sheets.Count).Cells(loZeile - 2, 1)

Gruß

JöKe

Hallo JöKe,

Danke das Du Dir immer die Zeit nimmst. Leider klappt das nicht so. Könnte man das nichtr mit diesem Code kombinieren???


Option Explicit

Private Sub CommandButton1_Click()
Dim loLetzte1 As Long, loLetzte2 As Long
Application.ScreenUpdating = False
loLetzte1 = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
loLetzte2 = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
If loLetzte2 < 15 Then
loLetzte2 = 15
End If
Sheets("Tabelle1").Columns("A:E").AutoFilter Field:=1, Criteria1:="x"
Sheets("Tabelle1").Columns("A:E").AutoFilter Field:=3, Criteria1:="<>"
Sheets("Tabelle1").Range(Cells(2, 2), Cells(loLetzte1, 5)).SpecialCells(xlCellTypeVisible).Copy
Sheets("Tabelle2").Cells(loLetzte2, 1).PasteSpecial
Selection.AutoFilter
Sheets("Tabelle2").Select
With Selection.Borders(xlEdgeLeft)
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.Weight = xlMedium
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


Dieser Code von Dir kopiert ja die Zeilen wo in Spalte A ein x steht die Zeilen in ein anderes Tabellenblatt. Kann man jetzt nicht einfach sagen: die Zeilen 397 - 400 werden immer ganz unten auft die letzte Seite kopiert???

Ich danke Dir!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Gruß

Elhamplo

Moin Elhamplo,

Private Sub CommandButton1_Click()
Dim loLetzte1 As Long, loLetzte2 As Long

Dim iSeiten As Integer, iUmbruch As Integer, loZeile As Long

Application.ScreenUpdating = False
loLetzte1 = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
loLetzte2 = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
If loLetzte2 < 15 Then
loLetzte2 = 15
End If
Sheets("Tabelle1").Columns("A:E").AutoFilter Field:=1, Criteria1:="x"
Sheets("Tabelle1").Columns("A:E").AutoFilter Field:=3, Criteria1:="<>"
Sheets("Tabelle1").Range(Cells(2, 2), Cells(loLetzte1, 5)).SpecialCells(xlCellTypeVisible).Copy
Sheets("Tabelle2").Cells(loLetzte2, 1).PasteSpecial
Selection.AutoFilter
Sheets("Tabelle2").Select
With Selection.Borders(xlEdgeLeft)
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.Weight = xlMedium
End With
Application.CutCopyMode = False

Sheets("Tabelle2").Select
iSeiten = ExecuteExcel4Macro("Get.Document(50)")
If iSeiten = 1 Then
loZeile = 56
GoTo Weiter
Else
iUmbruch = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64)," & iSeiten - 1 & ")")
loZeile = (iUmbruch - 1) + (iUmbruch - 1) / (iSeiten - 1)
Weiter:
Sheets("Tabelle1").Range("A397:G400").Copy _
Destination:=Sheets("Tabelle2").Cells(loZeile - 4, 1)
End If

Application.ScreenUpdating = True
End Sub

Gruß

JöKe

Destination:=Sheets("Tabelle2").Cells(loZeile - 4, 1)

hier muss es -3 sein.

Hallo,

Sorry, das ich mich erst jetzt melde. Hab einen kleinen Urlaub gemacht und hatte kein Rechner dabei.

SUPER!!!!! Danke, danke, danke!!!!!!

Funktioniert genauso wie ich mir das dachte!!!!

Danke das Du mir so geholfen hast!!

Einfach klasse!!!

Gruß

Elhamplo

• Makro Zeilen einfügen
• mehrere Zeilen in Excel einfügen
• Leerzeilen einfügen
• Zeilen einfügen