Find specific hours in worksheets, copy and paste (tranpose) in matrix.

Bamerand

Board Regular
Joined
Jan 11, 2013
Messages
62
On daily basis, I work with files that I need to extract data for specific time (04:00, 08:00, 12:00, 16:00, 20:00 and 00:00). "00:00" is for today and the rest of hours go back to yesterday timing (in retrospect). The previous code from web-page "Re: 2-Digit Year" was required to format dates (see screen-shot 02).
In the 3rd screen-shot shown the data I need to pull from each page of a workbook. It is highlighted in green, in the column "I" for the hours 04:00, 08:00, 12:00, 16:00, 20:00 and 00:00 (see screen-shot 03 and screen-shot 05). How can I make a proper macro that loops through entire workbook, copies the required data and pastes (transpose) it in a separate worksheet with name of each worksheet corresponding? See screenshot-4 for clarification (the way I need the data organized).

I tried to do the combination of these macros. But it makes only half of the required task. Is there a way to make it fully automatic? I am using MS Excel 2010.

Here are posted the screenshots.

https://picasaweb.google.com/bamerand/April212013#5869087256991361474
https://picasaweb.google.com/bamerand/April212013#5869087272939589410
https://picasaweb.google.com/bamerand/April212013#5869087268998133922
https://picasaweb.google.com/bamerand/April212013#5869087305766003106
https://picasaweb.google.com/bamerand/April212013#5869087321868604802

Sub Select_Hours()
Selection.AutoFilter Field:=1, Criteria1:=Array("00:00", "04:00", "08:00", "12:00", "16:00", _
"20:00", "4:00", "8:00", "0:00"), Operator:=xlFilterValues
With Selection
.Interior.Color = 65535
End With
End Sub

Sub GoToDate()
Dim MyRow As Long
With Worksheets("120")
MyRow = .Columns("A").Find(Date).Row
Application.Goto .Range("A" & MyRow), True
End With
End Sub


Sub ChDates()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
For i = 1 To LR
With Range("A" & i)
.NumberFormat = "dd/mm/yyyy"
.Value = DateValue(.Value)
End With
Next i
End Sub
 

Some videos you may like

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Watch MrExcel Video

Forum statistics

Threads
1,122,387
Messages
5,595,884
Members
414,029
Latest member
mrwilker

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top