von Stephan » Sa, 24.11.2018 23:14
Das
konkrete Makro läüft auch ohne Veränderung in OO/LO Calc, wenn man am Anfang die Kompatibilitätsoption (Option VBASupport 1) hinzufügt, also:
Code: Alles auswählen
Option VBASupport 1
Sub Schwanzkopie()
Dim UltimaLinha_Plan1 As Long
Dim UltimaLinha_Plan2 As Long
Dim RngACopiarA As Range
Dim RngACopiarB As Range
UltimaLinha_Plan1 = Worksheets("Planilha1").Cells(Rows.Count, 1).End(xlUp).Row
Set RngACopiarA = Worksheets("Planilha1").Range("A2:" & "A" & UltimaLinha_Plan1)
Set RngACopiarB = Worksheets("Planilha1").Range("B2:" & "B" & UltimaLinha_Plan1)
UltimaLinha_Plan2 = Worksheets("Planilha2").Cells(Rows.Count, 10).End(xlUp).Row + 1
RngACopiarA.Copy
Worksheets("Planilha2").Range("J" & UltimaLinha_Plan2).PasteSpecial Paste:=xlPasteValues
RngACopiarB.Copy
Worksheets("Planilha2").Range("L" & UltimaLinha_Plan2).PasteSpecial Paste:=xlPasteValues
Worksheets("Planilha2").Select
Range("A1").Select
Application.CutCopyMode = False
End Sub
ansonsten kann man auch beispielsweise folgenden StarBasic-Code verwenden:
Code: Alles auswählen
Sub Kopieren_OO()
With Thiscomponent.Sheets
With.getByName("Planilha1")
oleer = .Columns(0).queryemptycells
oletzter=oleer(oleer.count-1).rangeaddress.startrow-1
werte = .getCellRangeByPosition(0,1,0,oletzter).getDataArray
werte2 = .getCellRangeByPosition(1,1,1,oletzter).getDataArray
End With
With .getByName("Planilha2")
oleer2 = .Columns(9).queryemptycells
oletzter2=oleer2(oleer2.count-1).rangeaddress.startrow-1
.getCellRangeByPosition(9,oletzter2+1,9,oletzter2+oletzter).setDataArray(werte)
.getCellRangeByPosition(11,oletzter2+1,11,oletzter2+oletzter).setDataArray(werte2)
End With
End With
End Sub
Gruß
Stephan
Das [i]konkrete [/i]Makro läüft auch ohne Veränderung in OO/LO Calc, wenn man am Anfang die Kompatibilitätsoption (Option VBASupport 1) hinzufügt, also:
[code]Option VBASupport 1
Sub Schwanzkopie()
Dim UltimaLinha_Plan1 As Long
Dim UltimaLinha_Plan2 As Long
Dim RngACopiarA As Range
Dim RngACopiarB As Range
UltimaLinha_Plan1 = Worksheets("Planilha1").Cells(Rows.Count, 1).End(xlUp).Row
Set RngACopiarA = Worksheets("Planilha1").Range("A2:" & "A" & UltimaLinha_Plan1)
Set RngACopiarB = Worksheets("Planilha1").Range("B2:" & "B" & UltimaLinha_Plan1)
UltimaLinha_Plan2 = Worksheets("Planilha2").Cells(Rows.Count, 10).End(xlUp).Row + 1
RngACopiarA.Copy
Worksheets("Planilha2").Range("J" & UltimaLinha_Plan2).PasteSpecial Paste:=xlPasteValues
RngACopiarB.Copy
Worksheets("Planilha2").Range("L" & UltimaLinha_Plan2).PasteSpecial Paste:=xlPasteValues
Worksheets("Planilha2").Select
Range("A1").Select
Application.CutCopyMode = False
End Sub[/code]
ansonsten kann man auch beispielsweise folgenden StarBasic-Code verwenden:
[code]Sub Kopieren_OO()
With Thiscomponent.Sheets
With.getByName("Planilha1")
oleer = .Columns(0).queryemptycells
oletzter=oleer(oleer.count-1).rangeaddress.startrow-1
werte = .getCellRangeByPosition(0,1,0,oletzter).getDataArray
werte2 = .getCellRangeByPosition(1,1,1,oletzter).getDataArray
End With
With .getByName("Planilha2")
oleer2 = .Columns(9).queryemptycells
oletzter2=oleer2(oleer2.count-1).rangeaddress.startrow-1
.getCellRangeByPosition(9,oletzter2+1,9,oletzter2+oletzter).setDataArray(werte)
.getCellRangeByPosition(11,oletzter2+1,11,oletzter2+oletzter).setDataArray(werte2)
End With
End With
End Sub
[/code]
Gruß
Stephan