formatting my copied data

hi
have this vb code that copies data i want from one to excel sheet to another
here is code

Code:

---

Sub Exporting_Data1()
Dim i As Long, LR As Long
Application.ScreenUpdating = False
On Error Resume Next

Set ms = Sheets("Sheet2")
    With Worksheets("Sheet1")
        LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
          For i = 1 To LR
            If IsDate(.Cells(i, 1)) Then
                .Cells(i, 1).Copy
                ms.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            End If
                If Len(.Cells(i, "AD")) And .Cells(i, "AD") = "FUND OWNERSHIP %" Then
                .Cells(i, "AD").Offset(1).Resize(4).Copy
                ms.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
              End If
          Next i
    End With
               
Application.CutCopyMode = 0
Columns(1).NumberFormat = "dd/mm/yyyy"
Application.ScreenUpdating = True

End Sub

---

now the code does work to a certain point. it copies it over and this is how it looks when it does

Code:

---

DATE              NOK/IA1        Monthly Average        NOK/IA2        Monthly Average        NOK/RA1        Monthly Average        NOK/RA 2        Monthly Average
01/11/2012        0.00%        20.71%                76.01%        3.28%

---

i need it to look like this

Code:

---

DATE              NOK/IA1        Monthly Average        NOK/IA2        Monthly Average        NOK/RA1        Monthly Average        NOK/RA 2        Monthly Average
01/11/2012        0.00%                        20.71%                        76.01%                        3.28%

---

any ideas how i can get it to copy over like this

Are you doing this from within Office or VB6?

doin it within office

In the case your thread would be better served in the Office Development forum section so I have moved.

can anyone help with this

anyone any ideas on this

It would be easier to step through if you uploaded a zipped version of your workbook. I'm having trouble simulating what you're trying to do.

ok sorry
here is a zip file i put it into one book to make it easier

sheet1 is the file i get in shhet2 is how it looks after i run my code and sheet3 is how i want it to look.
here is my file
Attachment 94995
and here is code again.

Code:

---

Sub FUND_OWNERSHIP()
Dim i As Long, LR As Long
Application.ScreenUpdating = False
On Error Resume Next

   
   
    Set ms = Workbooks("Book4.xlsx").Sheets("Allocation")
    With Worksheets("Allocation")

        LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
          For i = 1 To LR
            If IsDate(.Cells(i, 1)) Then
                .Cells(i, 1).Copy
                ms.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            End If
                If UCase$(.Cells(i, 30).Value) = "FUND OWNERSHIP %" Then
                                             
                .Cells(i, "AD").Offset(1).Resize(4).Copy
                Debug.Print
                ms.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
              End If
          Next i
    End With
         
Application.CutCopyMode = 0
Columns(1).NumberFormat = "dd/mm/yyyy"
Application.ScreenUpdating = True

End Sub

---

Try something more like this (sub in the right names for your sheets, etc.):

Code:

---

Sub copyData()
    Dim wsData As Worksheet
    Dim wsCopyTo As Worksheet
    Dim i As Long
    Dim LR As Long
   
    Set wsData = Worksheets("Sheet1")
    Set wsCopyTo = Worksheets("Sheet2")
    LR = wsData.Range("a" & Rows.Count).End(xlUp).Row
   
    For i = 1 To LR
        If IsDate(wsData.Range("a" & i).Value) Then
            wsData.Range("a" & i).Copy
            wsCopyTo.Range("a" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
            wsData.Range("ad" & i + 3).Copy
            wsCopyTo.Range("b" & Rows.Count).End(xlUp).Offset(1).PasteSpecial  'd,f,h
            wsData.Range("ad" & i + 4).Copy
            wsCopyTo.Range("d" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
            wsData.Range("ad" & i + 5).Copy
            wsCopyTo.Range("f" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
            wsData.Range("ad" & i + 6).Copy
            wsCopyTo.Range("h" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
        End If
    Next i
   
End Sub

---