Macro Loop and Paste in next empty row

**Rayhoop** · 05-14-2008, 01:10 PM

Right..

Ive been having a play - close but no cigar.

the code I have at the moment is

Sub reformat_data()
'
' reformat_data Macro
'
' Keyboard Shortcut: Ctrl+p
'
odc = 1
maxapps = 2
While Range("A" & odc) <> ""
    odc = odc + 1
    MsgBox "odc value is: " & odc
    Range("A" & odc & ":G" & odc).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("C2").Select
    ActiveSheet.Paste
    
    Range("C5:J37").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Range("A" & maxapps).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    
    maxapps = maxapps + 34
    
Wend

    
End Sub

BUT... it does not select the next row and copy/paste the range into sheet2!c5 correctly :0(
After the 1st attempt, odc appears to be incrementing (as the message box shows this), but it does not select/copy/paste the correct range - it appears as it is trying to copy the same range :0s

Any ideas?

**VBA Noob** · 05-14-2008, 01:19 PM

Rayhoop,

Not sure I follow the logic of the code. Can you upload a sample workbook with a before and after or see if the below helps

Usually you can find the last cell with this statement

Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
'Where A = Last Value in Col A

This link explains in more detail

http://www.rondebruin.nl/copy1.htm

VBA Noob

**Rayhoop** · 05-14-2008, 02:09 PM

Cheers mate.

I replaced the 'find last' with a crude method of selecting a cell 34 rows down using

maxapps = maxapps +34

34 because the number of rows selected from sheet2 were 33. However in the cut down demo spreadsheet I've only included a handful.

My end loop statment doesnt work either :0( I have to 'escape' out of the macro.

odc stands for 'original data cell', so in theory incrementing it by 1 would push the cell range down a row?

Thanks again for your help.

**VBA Noob** · 05-14-2008, 02:36 PM

Still not clear what your after. This copies Sheet 1 to Sheet 4. Note's may help

Sub CopyToNewSheet()
Dim SrcLastRow As Long
Dim DestLastRow As Long
Dim SrcSht As Worksheet
Dim DestSht As Worksheet

'Source data worksheet
Set SrcSht = Sheets("Sheet1")
'Destination worksheet
Set DestSht = Sheets("Sheet4")

'Source data Last Row using Column A
SrcLastRow = SrcSht.Cells(Rows.Count, "A").End(xlUp).Row

'Destination sheet Last Row using Column A
DestLastRow = DestSht.Cells(Rows.Count, "A").End(xlUp).Row + 1

'Copy Source sheet A2 to G and Last row to next row in Destination sheet
SrcSht.Range("A2:G" & SrcLastRow).Copy _
Destination:=DestSht.Range("A" & DestLastRow)

End Sub

VBA Noob

Macro Loop and Paste in next empty row

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions