PDA

View Full Version : Solved: Advice On Macro For Transfering Data



Barryj
02-24-2007, 08:51 AM
I have data in sheet 1 that I want to transfer to Time Sheet Week1,
this data on sheet 1 runs down for 80 rows and the same for the time sheet.

I have recorded a macro of the first line but need help in making this macro as compact as possible, I also don't know how to get it to select each new row in sheet1 and place the data in the next time sheet page.

Can this be done by a loop, I have included a sample file to help show what I am trying to do.


Thanks for any assistance.

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 25/02/2007 by Barry
'
'
Sheets("Time Sheet Week1").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[3]C[51]"
Range("E1").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[3]C[-3]"
Range("E2").Select
Range("B2").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[2]C[2]"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[2]C[2]"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[2]C[-1]"
Range("B3").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[1]C[6]"
Range("C3").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[1]C[6]"
Range("G3").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[1]C[3]"
Range("B4").Select
ActiveCell.FormulaR1C1 = "=Sheet1!RC[10]"
Range("C4").Select
ActiveCell.FormulaR1C1 = "=Sheet1!RC[10]"
Range("G4").Select
ActiveCell.FormulaR1C1 = "=Sheet1!RC[7]"
Range("B5").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-1]C[14]"
Range("C5").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-1]C[14]"
Range("G5").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-1]C[11]"
Range("B6").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-2]C[18]"
Range("C6").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-2]C[18]"
Range("G6").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-2]C[15]"
Range("B7").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-3]C[22]"
Range("C7").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-3]C[22]"
Range("G7").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-3]C[19]"
Range("B8").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-4]C[26]"
Range("C8").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-4]C[26]"
Range("G8").Select
ActiveCell.FormulaR1C1 = "=Sheet1!R[-4]C[23]"
Range("G9").Select
End Sub

lynnnow
02-24-2007, 09:03 AM
Hi,

If your cells for copying the data are fixed, then you can use a simple array and pick the appropriate cells with the offset function and then empty the array on the Time sheet.

HTH

Lynnnow

mdmackillop
02-24-2007, 09:45 AM
This will copy the values, not enter formulae. Let us know if you really require these.
Option Explicit
Sub Test()
Dim sh As Worksheet, Tsh As Worksheet
Dim i As Long, k As Long, Rw As Long
Set sh = Sheets("Sheet1")
Set Tsh = Sheets("Time Sheet Week1")
For i = 4 To sh.Cells(Rows.Count, 1).End(xlUp).Row
With Tsh
.Cells(Rw + 1, 5) = sh.Cells(i, 2)
.Cells(Rw + 1, 8) = sh.Cells(i, 59)
For k = 0 To 6
.Cells(Rw + 2 + k, 2) = sh.Cells(i, 4 + (4 * k))
.Cells(Rw + 2 + k, 3) = sh.Cells(i, 5 + (4 * k))
.Cells(Rw + 2 + k, 7) = sh.Cells(i, 6 + (4 * k))
Next k
End With
Rw = Rw + 14
Next i
End Sub

Barryj
02-24-2007, 10:36 AM
Thanks for the replys, will test over weekend and get back to you with the results thanks again for your replys.

Barryj
02-25-2007, 05:59 PM
The macro works great thanks heaps, now 2 questions:
What do I have to alter in the macro to pick up the second weeks information from the 6-May till the 12-May, this will go onto a sheet called Time Sheet Week 2.

Also is it possible to have a input box that I can put in the relative sheet name and which Time Sheet Week it goes to, as there are 26 sheets to choose from.

ie: If I chose sheet 12 and wanted information from the 2nd week to transfer to Time Sheet Week 2.

So that I only have to have the one Macro?

Bob Phillips
02-26-2007, 03:07 AM
How is that data laid out, the different weeks?

Barryj
02-26-2007, 03:17 AM
It is laid out exactly as the example file, the macro at the moment takes the first week, I need to adjust it so it takes the second week, same layout.

I was thinking I might need to seperate macros to achieve this.

As I would want to call which week was transfered as there are 26 fortnights, maybe through an input of some sort.

Hope this makes some sort of sense.

I tried adjusting things on the macro that mdmackillop helped me with but to no avail.

Barryj
02-27-2007, 03:45 AM
Please?:banghead: :dunno

mdmackillop
02-27-2007, 04:20 AM
Hi Baary,
I couldn't quite follow what goes where. Can you explain further? What are your sheet names going to be?

Barryj
02-27-2007, 05:50 AM
Hi, There are 26 sheets where the data is pulled from, each sheet is named 1 to 26, the first macro you helped me with works great, it pulls the data for the first week and puts it into Time Sheet Week 1.

I need to then pull the data from the second week (Sunday to Saturday) and put it into Time Sheet Week 2.

Now is it possible to have an input box to decide which sheet the data will be pulled from, I would put these boxes in the time sheet sheet I guess so that when I need the data I can Type which sheet I need the data from.

Hope This makes some sense!

mdmackillop
02-27-2007, 04:02 PM
Here's a userform method

Barryj
02-28-2007, 12:48 AM
Hi MD, looks good tried to run the macro and am getting run time error on this line:
Set sh = Sheets("Sheet" & ShNo)

Was it ok for you.

Barryj
02-28-2007, 01:47 PM
All's well now problem solved, thanks again MD for all your assistance.

Barryj
06-17-2007, 08:31 PM
Just looking for some help on this macro to pick up the date that is in row 1 in the attachment for this thread, ie for week 1 or week 2 depending which one has been selected, this should be transfered to row 1 column 16 on the time sheet.
Sub Test(ShNo As Long, Wk As Long, TSNo As Long)
Dim sh As Worksheet, Tsh As Worksheet
Dim i As Long, k As Long, Rw As Long, Oset As Long
Set sh = Sheets("Sheet" & ShNo)
On Error Resume Next
Set Tsh = Sheets("Time Sheet Week" & TSNo)
If Tsh Is Nothing Then
Sheets.Add after:=Sheets("Time Sheet Week" & TSNo - 1)
ActiveSheet.Name = "Time Sheet Week" & TSNo
Set Tsh = Sheets("Time Sheet Week" & TSNo)
End If
If Wk = 2 Then Oset = 28
For i = 4 To sh.Cells(Rows.Count, 1).End(xlUp).Row
With Tsh
.Cells(Rw + 1, 5) = sh.Cells(i, 2)
.Cells(Rw + 1, 8) = sh.Cells(i, 59)
For k = 0 To 6
.Cells(Rw + 2 + k, 2) = sh.Cells(i, 4 + Oset + (4 * k))
.Cells(Rw + 2 + k, 3) = sh.Cells(i, 5 + Oset + (4 * k))
.Cells(Rw + 2 + k, 7) = sh.Cells(i, 6 + Oset + (4 * k))
.Cells(Rw + 2 + k, 2).Interior.ColorIndex = 6
.Cells(Rw + 2 + k, 3).Interior.ColorIndex = 7
.Cells(Rw + 2 + k, 7).Interior.ColorIndex = 8
sh.Cells(i, 4 + (4 * k)).Interior.ColorIndex = 6
sh.Cells(i, 5 + (4 * k)).Interior.ColorIndex = 7
sh.Cells(i, 6 + (4 * k)).Interior.ColorIndex = 8
Next k
End With
Rw = Rw + 14
Next i
End Sub

Thanks for any help