Macro Help

[cheekyblue]

Hi I need a macro but I really dont know what I am doing. I have a
spreadsheet with (sheet 1) data in columns A & B, Column A has a date and
time starting with mid-night and going up in half-hour increments, so 48 for
each day, Column B has data for each half-hour. I need to copy and paste each
day at a time (onto sheet 2) and transpose it so that I have a Date in A1,
half-hour 1 in A2, half-hour 2 in A3 etc. I can get it to do this but then
when i run my macro repeatedly it copies day 2 over day 1 etc.

Can anyone help me get the code right so that is choses the next available
row (sheet 2) to paste into and loop until there are no more days left (Sheet
1). The number of days will vary from month to month and I also may need this
quarterly so no upper bound on the loop if possible.

I kinda get the concept I just dont have enough experience to do this
myself, below is what I have managed through the "Record Macro" function in
excel.


Sub Data_Transpose()
'
' Data_Transpose Macro
'

'
Sheets("Sheet1").Select
Range("A1").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("B1:B48").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True
Sheets("Sheet1").Select
ActiveWindow.SmallScroll Down:=24
Range("A1:B48").Select
Range("B48").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Sheets("Sheet2").Select
Range("A2").Select
Columns("A:A").EntireColumn.AutoFit
End Sub

 

[Sheeloo]

Try

Sub Transpose()
Dim srcSheet As String
Dim destSheet As String
Dim i, j, lastRow As Long

srcSheet = "Sheet1"
destSheet = "Sheet2"

Worksheets(srcSheet).Activate

With Worksheets(srcSheet)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

lastRow = (lastRow / 48)
j = 1

For i = 1 To lastRow
Worksheets(srcSheet).Range("A" & j & ":A" & (j + 47)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(destSheet).Cells(i, 1).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
j = j + 48
Next i
End Sub

 

[cheekyblue]

Hi Sheeloo,

thanks for this, it kinda works how I need it to but I still have to do a
bit of messing about. I know it might sound fussy of me but could you help me
change the code so that the following happens.

1. It currently copies and tranposes the data from column A and I need it to
do it for Column B - I have managed to amend your code to do this - feeling
very clever now

2. I now have just the data for each half hour (in columns A to AV) what I
need is to insert the relevant date from column A of sheet 1 into column A of
sheet 2

If this is too much then I'm sure some copying and pasting can be done by
the end user

Thank you very much for you help so far!

Cheeky

 

[Sheeloo]

You are welcome.

1. It is a good feeling when you are able to do that...
It would have been great if you had pasted your modification so I could have
seen what you did... and comment if required

2. I will be happy to do this but not sure what you want... Which cells from
Col A are to be copied and where will they go...
I understand your Col B has gone to Sheet2 with each row having 48 items
across columns... starting at Row number?

 

[cheekyblue]

Hi again, I'll try to explain it a bit better.

Sheet 1 ("Paste Data Here") looks like this but there is a month of data and
runs until 18/03/2009

18/02/2009 00:00 1019.85
18/02/2009 00:30 1202.68
18/02/2009 01:00 1045.29
18/02/2009 01:30 1118.04
18/02/2009 02:00 1114.03
18/02/2009 02:30 1141.34

Sheet 2 ("Transposed Data") should look like this

18/02/2009 00:00 1019.85 1202.68 1045.29 1118.04 1114.03 1141.34
19/02/2009 00:00 1075.96 1194.03 981.55 1098.89 1117.46 1056.68
20/02/2009 00:00 1075.68 1228.16 1204.05 1141.99 1195.17 1179.33
21/02/2009 00:00 1128.69 1153.79 990.12 1103.15 968.56 1087.73

It is the date that I need to appear at the beginning of each row. I hope
this makes sense now?

here is the code I have modified

Sub Data_Transpose()
'
' Data_Transpose Macro
'
Dim srcSheet As String
Dim destSheet As String
Dim i, j, lastRow As Long

srcSheet = "Paste Data Here"
destSheet = "Transposed Data"

Worksheets(srcSheet).Activate

With Worksheets(srcSheet)
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

lastRow = (lastRow / 48)
j = 1

For i = 1 To lastRow
Worksheets(srcSheet).Range("B" & j & ":B" & (j + 47)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(destSheet).Cells(i, 1).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
j = j + 48
Next i
End Sub

 

[Sheeloo]

following line added
Worksheets(destSheet).Cells(i, 1) = Worksheets(srcSheet).Cells(j, 1)

Complete macro

don't forget to Format Col A in the destSheet


Sub Data_Transpose()
'
' Data_Transpose Macro
'
Dim srcSheet As String
Dim destSheet As String
Dim i, j, lastRow As Long

Application.ScreenUpdating = False
srcSheet = "Paste Data Here"
destSheet = "Transposed Data"

Worksheets(srcSheet).Activate

With Worksheets(srcSheet)
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

lastRow = (lastRow / 48)
j = 1

For i = 1 To lastRow
'Copy the date from srcsheet and paste in Col A of destsheet
Worksheets(destSheet).Cells(i, 1) = Worksheets(srcSheet).Cells(j, 1)
'Copy and transpose Col B, 48 at a time
Worksheets(srcSheet).Range("B" & j & ":B" & (j + 47)).Select
Application.CutCopyMode = False
Selection.Copy
Worksheets(destSheet).Cells(i, 2).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
j = j + 48
Next i
Application.ScreenUpdating = True
End Sub

 

[cheekyblue]

Hi Sheeloo,

I can't thank you enough for your help! I now want to add some formatting to
this macro for sheet 2 but I think I want to go it alone from now and see
what I can learn.

Cheeky