Copy Value to a Row with Date that is specified Query

[John]

I have some values in B1 through to B4. These relate to costs for 4
locations. In column A1 is the week that these costs relate to.

How can I write code to copy and paste these values to a different worksheet
within the same file that will look for the relevant date that I have listed
in Column A on this second worksheet. I want to Transpose this Paste
function as my locations are within column B through to column E

Hoe that all makes sense.

Thanks

 

[Tom Ogilvy]

Sub Tester2()
Dim sh As Worksheet
Dim rng As Range, rng1 As Range
Dim cell As Range, dt As Date
Set sh = Worksheets("Costs")
dt = sh.Range("A1").Value
With Worksheets("Sheet2")
Set rng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
End With
For Each cell In rng
If cell.Value2 = CLng(dt) Then
Set rng1 = cell
Exit For
End If
Next
If rng1 Is Nothing Then
MsgBox Format(dt, "mmm dd, yyyy") & "was not found"
Exit Sub
End If
sh.Range("B1:B4").Copy
rng1.Offset(0, 1).PasteSpecial Transpose:=True
End Sub

 

[John]

Thanks Tom

Sub Tester2()
Dim sh As Worksheet
Dim rng As Range, rng1 As Range
Dim cell As Range, dt As Date
Set sh = Worksheets("Costs")
dt = sh.Range("A1").Value
With Worksheets("Sheet2")
Set rng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
End With
For Each cell In rng
If cell.Value2 = CLng(dt) Then
Set rng1 = cell
Exit For
End If
Next
If rng1 Is Nothing Then
MsgBox Format(dt, "mmm dd, yyyy") & "was not found"
Exit Sub
End If
sh.Range("B1:B4").Copy
rng1.Offset(0, 1).PasteSpecial Transpose:=True
End Sub

 

[John]

Tom

How is it possible tocopy values say in C1:C4 in to a different worksheet
say Sheet3 within the same code.

I tried just replicating the code fora new sheet but it doesn't work for me.
Don't know what Next, End If statements I need and don't

Thanks

 

[Tom Ogilvy]

Sub Tester2()
Dim sh As Worksheet
Dim rng As Range, rng1 As Range
Dim cell As Range, dt As Date
Set sh = Worksheets("Costs")
dt = sh.Range("A1").Value
With Worksheets("Sheet3")
Set rng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
End With
For Each cell In rng
If cell.Value2 = CLng(dt) Then
Set rng1 = cell
Exit For
End If
Next
If rng1 Is Nothing Then
MsgBox Format(dt, "mmm dd, yyyy") & "was not found"
Exit Sub
End If
sh.Range("C1:C4").Copy
rng1.Offset(0, 1).PasteSpecial Transpose:=True
End Sub

 

[John]

Thanks for the reply Tom I know is probably a very basic question but how
can I include both Subs within the one sub so that all run under the same
macro?

 

[Tom Ogilvy]

One way would be to name the second one as Tester3 and call it from the
first one:

Sub Tester2()
Dim sh As Worksheet
Dim rng As Range, rng1 As Range
Dim cell As Range, dt As Date
Set sh = Worksheets("Costs")
dt = sh.Range("A1").Value
With Worksheets("Sheet2")
Set rng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
End With
For Each cell In rng
If cell.Value2 = CLng(dt) Then
Set rng1 = cell
Exit For
End If
Next
If rng1 Is Nothing Then
MsgBox Format(dt, "mmm dd, yyyy") & "was not found"
Exit Sub
End If
sh.Range("B1:B4").Copy
rng1.Offset(0, 1).PasteSpecial Transpose:=True
tester3
End Sub

Sub Tester3()
Dim sh As Worksheet
Dim rng As Range, rng1 As Range
Dim cell As Range, dt As Date
Set sh = Worksheets("Costs")
dt = sh.Range("A1").Value
With Worksheets("Sheet3")
Set rng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
End With
For Each cell In rng
If cell.Value2 = CLng(dt) Then
Set rng1 = cell
Exit For
End If
Next
If rng1 Is Nothing Then
MsgBox Format(dt, "mmm dd, yyyy") & "was not found"
Exit Sub
End If
sh.Range("C1:C4").Copy
rng1.Offset(0, 1).PasteSpecial Transpose:=True
End Sub

That is the simple solution. I would assume that if more was know about
what is being done, that a lot of the code wouldn't have to be repeated.

 

[John]

Thanks Tom, I'm an Excel user that can just find his way around basic code
normally I can suss out where to insert a second piece of code but this one
had me