遍历行,复制单元格,然后在新循环中移回原始工作表

时间:2018-09-04 15:17:06

标签: excel database vba excel-vba loops

我一直在尝试将以下请求的代码组合在一起,我不是专家,我真的需要帮助,在此先感谢:

有2张纸1“数据库”,2“记分卡”。

  • 浏览C列数据库工作表中的行,每个值 将被复制到记分卡工作表单元格B3中,这将更改 C30的值。
  • 然后需要将单元格C30的新值复制回新列“ F”中的数据库工作表,并将其循环直到 最后一个单元格。填写清单。
  • 它需要与单元格相对应,因此C2中的第一个值将需要F2中的匹配值,依此类推。
  • 数据库将随时间变化,因此它需要一个允许考虑新入口的代码。

我试图修改在另一个问题中看到的代码:Loops in VBA? I want to use a loop to select and copy till last cell,但无法使其正常工作...

非常感谢!

Sub LoopThroughColumnC()

Dim LastRowInColC As Long, Counter As Long
Dim SourceCell As Range, DestCell As Range
Dim MySheet As Worksheet
'set references up-front
Set MySheet = ThisWorkbook.Worksheets("Dati per calcolo")
Set CopySheet = ThisWorkbook.Worksheets("Scheda costo tessuto e capo")
With MySheet
    LastRowInColC = .Range("C" & .Rows.Count).End(xlUp).Row
    Set DestCell = ThisWorkbook.Worksheets("Scheda costo tessuto e capo").Range("B3")
End With
'loop through column C, copying from cells(counter, 11) to B3
With MySheet
    For Counter = 1 To LastRowInColC
        Set SourceCell = .Range("C" & Counter)
        SourceCell.Copy Destination:=DestCell

    If Target.Address = Range("A1").Address Then
        ' Get the last row on our destination sheet (using Sheet2, col A here)...
        Dim intLastRow As Long
        intLastRow = Sheet2.Cells(Sheet2.Rows.Count, "B").End(xlUp).Row
        ' Add our value to the next row...
        Sheet2.Cells(intLastRow + 1, "A") = Target.Value
    End If

    Next Counter
End With
End Sub

Here's how it looks

0 个答案:

没有答案