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

时间:2016-01-15 07:11:53

标签: excel excel-vba vba

我是VBA的新手,需要以下方面的帮助:

  1. 从工作表中的单元格B3,B4,B5,B6,B7复制值"工作"
  2. 在工作表"跟踪&#中分别将单元格的值粘贴到范围(F2,lastrow),(G2,lastrow),(H2,最后一行),(I2,lastrow),(J2,lastrow) 34;
  3. *" lastrow"在工作表"跟踪"将永远变化

    *单元格B3,B4,B5,B6,B7将始终具有不同的值

    例如

    钢板"工作"

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

    钢板"跟踪" lastrow使用代码lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

    确定为4

    所需输出如下所示

               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
    

    希望有人可以帮助我!谢谢!!

    解决方案

    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
    

2 个答案:

答案 0 :(得分:0)

这可能适合你

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

结束(xlDown).row将为您提供最后一个条目的行。

这个怎么样?

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

答案 1 :(得分:0)

以下是一个让您入门的选项:

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