VBA代码可将值从一个单元格复制到特定列

Question

I am very new to VBA and need help for the following:

1. Copy value from cell B3, B4, B5, B6, B7 in Worksheet "WORKING"
2. paste the value those of cells to Range (F2, lastrow), (G2, lastrow), (H2, last row), (I2, lastrow), (J2, lastrow) respectively in Worksheet "TRACKING"

*The "lastrow" in Worksheet "TRACKING" will always vary

*cell B3, B4, B5, B6, B7 will always have different values

For example

Sheets"WORKING"

B3 is A1234
B4 is A
B5 is B
B6 is 1
B7 is XX

Sheets"TRACKING" lastrow determined to be 4 using code lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

Output desired is shown below

           F         G         H         I         J
(Row 1)
(row 2)   A1234      A         B         1         XX
(row 3)   A1234      A         B         1         XX
(row 4)   A1234      A         B         1         XX

Hope someone can help me out!! thanks!!

SOLUTION FOUND

Sub data_transpose
Dim i As Integer
Dim lastrow As Long
Dim copyRange As Range
Dim sh As Worksheet
Set copyRng = Worksheets("WORKING").Range("B3:B7")
Set sh = Worksheets("TRACKING")

lastrow = sh.Range("A2", sh.Range("A2").End(xlDown)).Rows.Count + 1

For i = 2 To lastrow
copyRng.Copy
sh.Cells(i, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,    
_SkipBlanks:=False, Transpose:=True
Next i

End Sub

Answer 1

this might work for you

for jj=1 to #number_of_lines_you_want
for j = 6 to 10
   for i = 3 to worksheets("WORKING").cells(2,2).End(xlDown).Row
        lastrow = worksheets("TRACKING").cells(2,j).End(xlDown).Row
        worksheets("TRACKING").cells(i,j) = worksheets("WORKING").cells(i,2).value
   next i
next j
next jj

the end(xlDown).row will give you the row of the last entry.

What about this?

for i = 3 to 7
worksheets("WORKING").range("B3:B7").Copy
Worksheets("TRACKING").cells(i,6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

Answer 2

Here is one option to get you started:

Sub CopyData()
    Dim copyRng As Range, cl As Range, col As Integer, lastRow As Integer

    Set copyRng = Worksheets("Working").Range("B3:B7")
    col = 6 ' Denotes column F

    With Worksheets("Tracking")
        lastRow = .Cells(Rows.Count, "F").End(xlUp).Row

        For Each cl In copyRng
            .Range(.Cells(2, col), .Cells(lastRow, col)) = cl
            col = col + 1
        Next cl
    End With
End Sub