Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA for excel

Status
Not open for further replies.

Mattaille

Technical User
Jul 17, 2003
3
FR
Hi,
I'd like to copy for exemple from line 3 to line 4 and next from line 5 to 6 etc...
The problem is that I don't know I many lines I'm going to have in each file (it'a for a macro).

How can I program it exept with the following code:

Range("E3").Select
Selection.Copy
Range("E4").Select
ActiveSheet.Paste
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Range("E6").Select
ActiveSheet.Paste

Please can you help me?
 
Check out FAQ222-3383 to get started - it should point you in the right direction.
 
Can You be more precise because ther's a lot of things in this FAQ?
Thanks ;-)
 
Following code copies (=duplicates) a worksheet row into te next one, if the latter is empty. Copying starts at row 3, as the first two are considered to be headers. The worksheet is saved into another workbook as to preserve the original worksheet. The code can easily be adapted to suit your case.

Const c_strExcelInput As String = "D:/Addresses.xls"
Const
c_strExcelOutput As String = "D:/NewAddresses.xls"

Private Enum rvbCellCoordinate
rvbRow
rvbColumn
End Enum

Public Sub main()

Dim objExcel As Excel.Application
Set objExcel = New Excel.Application

Dim objWorkBook As Workbook
Set objWorkBook = objExcel.Workbooks.Open(FileName:=
c_strExcelInput)

Dim objWorkSheet As Worksheet
Set objWorkSheet = objWorkBook.Sheets(1)

Dim lngLastRow As Long
'check for the last row that is used
lngLastRow = GetLastCellCoordinate(objWorkSheet, rvbRow)

Select Case lngLastRow

Case Is >= 3
'first two rows are headers

With objWorkSheet

Dim lngRunningRow As Long
'copy every second row starting at the third one
For lngRunningRow = 3 To lngLastRow Step 2

'check if target row (runningrow+1) is empty
Select Case WorksheetFunction.CountA(.Rows(lngRunningRow + 1)) = 0

Case True

.Rows(lngRunningRow).Copy .Rows(lngRunningRow + 1)

Case False

MsgBox "Overwrite existing row?"
GoTo PROC_ERROR

End Select

Next

End With

Case Else

MsgBox "Not enough rows in worksheet"
GoTo PROC_ERROR

End Select

objWorkBook.SaveAs
c_strExcelOutput

PROC_EXIT:

Set objWorkSheet = Nothing
Set objWorkBook = Nothing

objExcel.Quit
Set objExcel = Nothing

Exit Sub

PROC_ERROR:

objWorkBook.Saved = True
'do not save, no processing done
GoTo PROC_EXIT

End Sub

Private Function GetLastCellCoordinate(objWks As Worksheet, Optional e_Coordinate As rvbCellCoordinate = rvbRow) As Long

'* Purpose: Obtain the Row or Column number of the effective last used Cell (i.e. excluding
'* formatted or unlocked cells)
'* Accepts: -objWks: Should be a valid Excel worksheet
'* -e_Coordinate: an enumerated constant with possible values rvbRow(default) or rvbColumn
'* Returns: A long numerical value containing the absolute coordinate.
'* Special values: 0 - no data found in worksheet
'* -1 : error encountered during processing
'* Remarks: Excel's UsedRange method (which could be used) seems to have some problems
'* Reference: EXCEL 2002 VBA by Stephen Bullen et. al. WROX ISBN 1-861005-70-9 pp111-112


Dim lngCoordinate As Long
lngCoordinate = 0

On Error Resume Next
'Intercept blank worksheet

Select Case e_Coordinate

Case rvbRow

lngCoordinate = objWks.Cells.Find(What:="*", _
After:=Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

Case rvbColumn

lngCoordinate = objWks.Cells.Find(What:="*", _
After:=Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

Case Else

GoTo PROC_ERROR

End Select

PROC_EXIT:

GetLastCellCoordinate = lngCoordinate
Exit Function

PROC_ERROR:

lngCoordinate = -1
GoTo PROC_EXIT

End Function




_________________________________
In theory, there is no difference between theory and practice. In practice, there is. [attributed to Yogi Berra]
 
you could try just inserting a row (efectively moving all cells down)

example code

myExcelWorksheet.Range("C2:H2").Insert (xlShiftDown)

good luck!!

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
The Great Date Debate Thread222-368305
File Formats Galore @ or
 
This looks kinda complicated! To move each line down one in Excel, just insert a new row at the top.

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first

'People who live in windowed environments shouldn't cast pointers.'
 
Thanks everybody, I use this code to do it and it works good (It's only vba so the code is not perfect)

Sub Conversion()
'
' Conversion Macro
' Macro enregistrée le 17/07/2003 par Matthieu
'

'
Dim str1, str2 As String
Dim n As Integer
Dim i

n = 5000

i = 2


Do While i < n

i = i + 1
str1 = &quot;E&quot; & i
i = i + 1
str2 = &quot;E&quot; & i

Range(str1).Select
Selection.Copy
Range(str2).Select
ActiveSheet.Paste

Loop

End Sub

I hope it can help beginners like me.
 
Sorry AD - I guess you type faster than me!

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first

'People who live in windowed environments shouldn't cast pointers.'
 
I thought the question was to move row 3 to 4, row 5 to 6, ... and so on. So I wrote the code to copy every second row after checking if the target row was empty (although not requested).

ADoozer: Inserting a row does indeed shifts all other rows down. As you do not know the number of rows in advance, the range bounds have probably to be readjusted after each insert?

johnw I didn't understand the question to move each line one down. But maybe that was the intent. Who knows but Mataille? I have no clue how the original worksheet looks like.

Anyhow, I got the impression that I refreshed my (limited) VBA Excel knowledge

_________________________________
In theory, there is no difference between theory and practice. In practice, there is. [attributed to Yogi Berra]
 
johnwm... i think ur still winning on the speed thing!! i must of had a good day! [lol]

rvbasic:
>I thought the question was to move row 3 to 4, row 5 to 6, ... and so on

i think this is how Mataille has opted to do it

Do While i < n

i = i + 1
str1 = &quot;E&quot; & i
i = i + 1
str2 = &quot;E&quot; & i

Range(str1).Select
Selection.Copy
Range(str2).Select
ActiveSheet.Paste

Loop

>As you do not know the number of rows in advance, the range bounds have probably to be readjusted after each insert?

true but then its a pretty easy substitute to do

myExcelWorksheet.Range(myRange).Insert (xlShiftDown)

where myRange is the desired range!

the way i read the post was that the new data was inserted into the first row after the columns titles (usually for me &quot;B3:?3&quot;)

anyway....it was a fun trip into the world of VB and excel again.... i think its time to update the faq.

If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
The Great Date Debate Thread222-368305
File Formats Galore @ or
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top