vba对于写入同一行的每个循环

时间:2017-04-30 13:37:25

标签: excel vba excel-vba

我想通过我的循环来解决一个问题。我需要从第13行的类列表表中复制所有受训数据,并将其放入名单注册表中相同的工作簿。然而,我最初写的代码是给我和错误当我使用.Range(i,1)所以我把它改为.Cells。主要担心的是代码将数据写入名册注册表,但只写入最后的受训者数据。

Option Explicit
Sub ExportcReg()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wbk1 As Workbook
Dim s1, cReg As Worksheet
Dim x, i, FinalRow As Long
Dim thisvalue As String
Set wbk1 = Workbooks.Open(ThisWorkbook.Worksheets("Info").Range("A1").Value)
Set s1 = wbk1.Sheets("ClassRegistry")
Set cReg = ThisWorkbook.Worksheets("Class Registry")

With cReg
    ' Find the last row of data in Column "A"
    FinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    ' Loop through each row
    For x = 2 To FinalRow
        ' Decide if to copy based on column A
        thisvalue = .Cells(x, 1).Value
        If thisvalue <> "" Then
            i = s1.Cells(s1.Rows.Count, 1).End(xlUp).Row + 1

            s1.Cells(i, 1).Value = thisvalue
            s1.Cells(i, 2).Value = .Cells(x, 2).Value
            s1.Cells(i, 3).Value = .Cells(x, 3).Value
            s1.Cells(i, 4).Value = .Cells(x, 4).Value
            s1.Cells(i, 5).Value = .Cells(x, 5).Value
            s1.Cells(i, 6).Value = .Cells(x, 5).Value
            s1.Cells(i, 7).Value = .Cells(x, 7).Value
            s1.Cells(i, 8).Value = .Cells(x, 8).Value
            s1.Cells(i, 9).Value = .Cells(x, 9).Value
            s1.Cells(i, 10).Value = .Cells(x, 10).Value
            s1.Cells(i, 11).Value = .Cells(x, 11).Value
            s1.Cells(i, 12).Value = .Cells(x, 12).Value
            s1.Cells(i, 13).Value = .Cells(x, 13).Value
            s1.Cells(i, 14).Value = .Cells(x, 14).Value
            s1.Cells(i, 15).Value = .Cells(x, 15).Value
            s1.Cells(i, 16).Value = .Cells(x, 16).Value
            s1.Cells(i, 17).Value = .Cells(x, 17).Value
            s1.Cells(i, 18).Value = .Cells(x, 18).Value
        End If
    Next x
End With
wbk1.Close savechanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

1 个答案:

答案 0 :(得分:0)

您的代码中存在太多逻辑和技术错误,我无法逐行解释。此外,您可以通过减少编码来实现目标。也许你需要的是一个工作代码,以了解事情是如何工作的。看看这个:

Sub CListtoRReg()
 'From Class List to Roster Registry
    Dim ws1 As Worksheet: Set ws1 = Worksheets("Class List")
    Dim ws2 As Worksheet: Set ws2 = Worksheets("Roster Registry")
    Dim i, j As Long
    For i = 13 To ws1.Cells(1, 1).End(xlDown).Row
           ws2.Cells(1, 1).End(xlDown).Offset(1) = ws1.Range("C2").Value
       For j = 2 To 11
           ws2.Cells(1, 1).End(xlDown).Offset(0, j - 1) = ws1.Cells(i, j - 1).Value
       Next j
    Next i
 End Sub