[Solved] Excel VBA to OOBASIC

[kanew7869]

Hi All,

I wonder if anyone could help me please. I am a newbie when it comes to coding and made a very simple VBA code for excel which took me days!!! really!!!

Anyway im finding the switch from Excel to Openoffice Basic very difficult. Would anyone be able to switch this Excel VBA code so that its workable on Open Office please?

Code: Select all

Rem Attribute VBA_ModuleType=VBAModule
Sub Module1
Rem Sub Systems_Copy_Paste()
Rem '
Rem ' Systems_Copy_Paste Macro
Rem '
Rem 
Rem '
Rem     Range("A34:D34").Select
Rem     Selection.Copy
Rem     Sheets("Sheet2").Select
Rem     Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Rem     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
Rem         :=False, Transpose:=False
Rem     Sheets("Sheet1").Select
Rem     Range("J2").Select
Rem     Selection.Copy
Rem     Sheets("Sheet2").Select
Rem     Range("E" & Rows.Count).End(xlUp).Offset(1).Select
Rem     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
Rem         :=False, Transpose:=False
Rem     Sheets("Sheet1").Select
Rem     Range("J10").Select
Rem     Selection.Copy
Rem     Sheets("Sheet2").Select
Rem     Range("F" & Rows.Count).End(xlUp).Offset(1).Select
Rem     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
Rem         :=False, Transpose:=False
Rem     Sheets("Sheet1").Select
Rem     Range("C19").Select
Rem     Selection.Copy
Rem     Sheets("Sheet2").Select
Rem     Range("G" & Rows.Count).End(xlUp).Offset(1).Select
Rem     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
Rem         :=False, Transpose:=False
Rem     Sheets("Sheet1").Select
Rem     Range("E23").Select
Rem     Selection.Copy
Rem     Sheets("Sheet2").Select
Rem     Range("H" & Rows.Count).End(xlUp).Offset(1).Select
Rem     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
Rem         :=False, Transpose:=False
Rem     Sheets("Sheet1").Select
Rem     Range("C32").Select
Rem     Selection.Copy
Rem     Sheets("Sheet2").Select
Rem     Range("I" & Rows.Count).End(xlUp).Offset(1).Select
Rem     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
Rem         :=False, Transpose:=False
Rem     Sheets("Sheet1").Select
Rem     Range("B2:F3").Select
Rem     Selection.ClearContents
Rem     Range("B10:D12").Select
Rem     Selection.ClearContents
Rem     Range("B14:D16").Select
Rem     Selection.ClearContents
Rem     Range("B23:C25").Select
Rem     Selection.ClearContents
Rem     Range("B27:C29").Select
Rem     Selection.ClearContents
Rem     Range("C2").Select
Rem     ActiveCell.Formula = "=sum(D2:F2)"
Rem     Range("C3").Select
Rem     ActiveCell.Formula = "=sum(D3:f3)"
Rem     Range("B2").Select
Rem End Sub
End Sub

Please excuse all the 'Rem' its how it opened from my save from Excel.

If any one could change this so it works on OOfice i would be very grateful.

If you need any further information please ask

Thank you,
Kane

[FJCC]

Is the data on Sheet2 in a rectangle? That is, is the last occupied row the same in columns A - I?

Edit: And is the only data on Sheet2 in the columns A - I?

[kanew7869]

Hi fjcc,

Thank you for the reply.

Yes the data sheet in sheet2 is from column A to I and is the only data on sheet2. Yes all copied cells from sheet1 will have data that needs copying, so the table in sheet2 will always have the same occupied cells from A to I.

I hope this helps. If you need any further info please ask.

Thanks,
Kane

[JohnSUN-Pensioner]

I think that it will be something like as

Code: Select all

Sub Systems_Copy_Paste()
Dim oSheets As Variant
Dim oSheet1 As Variant
Dim oSheet2 As Variant
Dim oCellRange As Variant
Dim oDataArray As Variant
Dim oData As Variant
Dim oCurrentController As Variant
Dim lastRow As Long
	GlobalScope.BasicLibraries.LoadLibrary("Tools")	' Standard Library
	oSheets = ThisComponent.getSheets()		' All sheets of workbook
	oSheet1 = oSheets.getByName("Sheet1")	' First sheet as object
	oSheet2 = oSheets.getByName("Sheet2")	' Second sheet as object
	oCellRange = oSheet1.getCellRangeByName("A34:D34")	' Range with first portion of copydata
	oDataArray = oCellRange.getDataArray()	' Data from this cells (as array of arrays)
	oData = oDataArray(0)	
	ReDim Preserve oData(0 To 8)	' "stretch" array to 9 elements (to column I)
	oData(4) = GetValueOfCellbyName(oSheet1,"J2")	' Fill array with data from Sheet1
	oData(5) = GetValueOfCellbyName(oSheet1,"J10")
	oData(6) = GetValueOfCellbyName(oSheet1,"C19")
	oData(7) = GetValueOfCellbyName(oSheet1,"E23")
	oData(8) = GetValueOfCellbyName(oSheet1,"C32")
	oDataArray(0) = oData	' Return new data to "array of arrays"
	lastRow = GetLastUsedRow(oSheet2)+1	' First unused row on Sheet2
	oSheet2.getCellRangeByPosition(0, lastRow, 8, lastRow).setDataArray(oDataArray)	' Put data to Sheet2
REM Clear some ranges
	oSheet1.getCellRangeByName("B2:F3").clearContents(1023)
	oSheet1.getCellRangeByName("B10:D12").clearContents(1023)
	oSheet1.getCellRangeByName("B14:D16").clearContents(1023)
	oSheet1.getCellRangeByName("B23:C25").clearContents(1023)
	oSheet1.getCellRangeByName("B27:C29").clearContents(1023)
REM Set formulas
	oSheet1.getCellRangeByName("C2").setFormula("=sum(D2:F2)")
	oSheet1.getCellRangeByName("C3").setFormula("=sum(D3:F3)")
REM Select cell Sheet1.B2
	oCurrentController = ThisComponent.getCurrentController()
	oCellRange = oSheet1.getCellRangeByName("B2")
	oCurrentController.Select(oCellRange)
REM ...and @unselect it
	oCellRange = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
	oCurrentController.Select(oCellRange)
End Sub

[kanew7869]

Hi JohnSUN

Thank you very much for replying. Your code has done everything i asked - copied all required cells to the relevant place on sheet2.

One thing i didn't mention which i didn't think was relevant, but was wrong!

The cells from sheet1 which need to cleared after the data has been copied are all highlighted cells (makes it easy to see the cells which need to be filled in). Is there a way of only clearing the text from the cells rather than the color? or do i need to enter in code to re-highlight the cells? if so what would the code need to be?

Thanks again for your help.

Kane

[JohnSUN-Pensioner]

Just replace all .clearContents(1023) with .clearContents(7)

[kanew7869]

Perfect thank you very much for your help... Works like a charm!

Thank you again.