每个循环写入同一行的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

选项显式
副出口信用证（）
Application.ScreenUpdating=False
Application.DisplayAlerts=False
将wbk1设置为工作簿
尺寸s1，cReg As工作表
暗淡的x，我，最后，只要
将此值设置为字符串
设置wbk1=Workbooks.Open（ThisWorkbook.Worksheets（“信息”）.Range（“A1”）.Value）
Set s1=wbk1.Sheets（“类注册表”）
Set cReg=ThisWorkbook.Worksheets（“类注册表”）
有皱纹
'在列“A”中查找最后一行数据'
FinalRow=.Cells（.Rows.Count，“A”）.End（xlUp）.Row
'循环通过每一行
对于x=2到最终路径
'根据A列决定是否复制
thisvalue=.Cells（x，1）.Value
如果该值为“”，则
i=s1.单元格（s1.Rows.Count，1）.结束（xlUp）.行+1
s1.单元格（i，1）.值=此值
s1.单元格（i，2）.Value=.Cells（x，2）.Value
s1.单元格（i，3）.Value=.Cells（x，3）.Value
s1.单元格（i，4）.Value=.Cells（x，4）.Value
s1.单元格（i，5）.Value=.Cells（x，5）.Value
s1.单元格（i，6）.Value=.Cells（x，5）.Value
s1.单元格（i，7）.Value=.Cells（x，7）.Value
s1.单元格（i，8）.Value=.Cells（x，8）.Value
s1.单元格（i，9）.Value=.Cells（x，9）.Value
s1.单元格（i，10）.Value=.Cells（x，10）.Value
s1.单元格（i，11）.Value=.Cells（x，11）.Value
s1.单元格（i，12）.Value=.Cells（x，12）.Value
s1.单元格（i，13）.Value=.Cells（x，13）.Value
s1.单元格（i，14）.Value=.Cells（x，14）.Value
s1.单元格（i，15）.Value=.Cells（x，15）.Value
s1.单元格（i，16）.Value=.Cells（x，16）.Value
s1.单元格（i，17）.Value=.Cells（x，17）.Value
s1.单元格（i，18）.Value=.Cells（x，18）.Value
如果结束
下一个x
以
wbk1.Close savechanges:=真
Application.DisplayAlerts=True
Application.ScreenUpdating=True
端接头

您的代码中有太多逻辑和技术错误，我无法逐行解释。此外，您可以用更少的编码实现您的目标。也许你需要的是一个工作代码来理解事物是如何工作的。看看这个：

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

---

变量

i

没有改变，因此数据是在前一个变量上写入的：您只看到最后一个变量。尝试使用

k=1

，

ws2.Cells（k，8）.Value

，和

k=k+1

。不管怎样，我不清楚你假装在做什么。抱歉搞混了。我需要做的是从班级列表表的第13行及以下复制每个学员的信息，并将其复制到花名册注册表表中，但我需要它来查找第一个空行并开始在那里写入。您的问题之一是单元格（0，1）。您指的是不存在的行号0。