Copy range from 1 wks to another w/loop

D

Dan

I have a worksheet("S1")with a variable number of rows,
starting at A2. There are 2 parts to moving this data onto
wks ("F1"):

The first part is beginning with wks S1 at cell K2, I have
to copy this date value onto wks F1 starting at cell A2
and then come back to wks S1 and copy Range(A2:J2)to the
same row on wks F1 beginning at B2.

The second part is that I have to come back to wks S1 and
check if there is another date in L2 to send back to wks
F1 cell A3 and again attach the same row range(A2:J2). If
there is no data in L2 I drop down to the next row and do
the above first part again.

note: from K2: and out I may have a variable amounts of
dates that I have to loop thru before I drop to the next
row. The final product on F1 should have all my dates in
column A followed by the range data beginning in Column B.

I did't paste my coding because it is a looping mess for
not using ranges...and it does not work! Can anyone help?

..
 
G

Guest

Dan,

The following code works for my interpretation of your post. My
interpretation may be wrong. Note that selecting, copying and pasting isn't
actually needed. The macro just specifies that the sheet F1 cell values
should be such-and-such. The code was written in a hurry and tested very
briefly.

Hope it does the trick.

Regards,
Greg

Sub TransferData()
Dim c As Range, cc As Range, rng As Range
Dim wksS1 As Worksheet, wksF1 As Worksheet
Application.ScreenUpdating = False
Set wksS1 = Worksheets("S1")
Set wksF1 = Worksheets("F1")
Set c = wksS1.Range("K2")
Set rng = wksS1.Range("A2:J2")
Set cc = wksF1.Range("A2")
Do Until Trim(c) = ""
Do Until Trim(c) = ""
cc.Value = c.Value
Range(cc(1, 2), cc(1, 11)) = rng.Value
Set c = c(1, 2)
Set cc = cc(2)
Loop
Set c = wksS1.Cells(c.Row + 1, 11)
Loop
Application.ScreenUpdating = True
End Sub
 
G

Guest

If you meant for "A2:J2" to step down to "A3:J3" when it steps down to a new
row in sheet S1 then insert:
"Set rng = rng(2, 1)"
after the existing line:
"Set c = wksS1.Cells(c.Row + 1, 11)"

Regards,
Greg
 
G

Guest

Try this:


Option Explicit

Sub CopyToF1()

Dim Rng As Range
Dim i As Integer
Dim Dest As Range

Set Rng = Sheets("S1").Range("K2")
If Sheets("F1").Range("A1") = "" Then
Set Dest = Sheets("F1").Range("A2")
Else
Set Dest = Sheets("F1").Range("A65536").End(xlUp)
End If
While Rng <> ""
While Rng.Offset(0, i) <> ""
Rng.Offset(0, i).Copy Dest
Range(Rng.Offset(0, -10), Rng.Offset(0, -1)).Copy Dest.Offset(0,
1)
Set Dest = Dest.Offset(1, 0)
i = i + 1
Wend
Set Rng = Rng.Offset(1, 0)
i = 0
Wend

Set Rng = Nothing

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top