Question

我是VBA的新手。我试图将单元格从一个工作簿复制到另一个工作簿。在某些情况下，“发送”工作簿文件只有1行要复制，而在其他情况下，它可能有多行我想要复制。目前一次只能使用一行。我尝试添加Do直到，但继续得到编译错误“循环没有做”，无法弄清楚我做错了什么。在我的“发送”工作表中，我开始从单元格H4发送，当列H，行x为空时，我想退出循环。希望有意义谢谢!!

Private Sub CommandButton1_Click()

    Dim RowNumber As Single
    Dim QuestionID As String
    Dim Question As String
    Dim TotalResponses As Single
    Dim StronglyAgree As Single
    Dim Agree As Single
    Dim NA As Single
    Dim Disagree As Single
    Dim StronglyDisagree As Single
    Dim Total As Single
    Dim RecordID As String
    Dim MATSEvalSummary As Workbook

    RowNumber = 4

    Worksheets("Data for MATS Summary File").Select

    Do Until Cells.Item("H" & RowNumber) = ""

      QuestionID = Range("H" & RowNumber)
      Question = Range("I" & RowNumber)
      TotalResponses = Range("j" & RowNumber)
      StronglyAgree = Range("k" & RowNumber)
      Agree = Range("l" & RowNumber)
      NA = Range("m" & RowNumber)
      Disagree = Range("n" & RowNumber)
      StronglyDisagree = Range("O" & RowNumber)
      Total = Range("P" & RowNumber)
      RecordID = Range("u" & RowNumber)

      Set MATSEvalSummary = Workbooks.Open("C:\MATS Eval Summary\170910 MATS Evals Summary.xlsx")
      Worksheets("sheet1").Select
      Worksheets("sheet1").Range("A1").Select
      RowCount = Worksheets("sheet1").Range("A1").CurrentRegion.Rows.Count
        With Worksheets("Sheet1").Range("A1")

      .Offset(RowCount, 0) = QuestionID
      .Offset(RowCount, 1) = Question
      .Offset(RowCount, 2) = TotalResponses
      .Offset(RowCount, 3) = StronglyAgree
      .Offset(RowCount, 4) = Agree
      .Offset(RowCount, 5) = NA
      .Offset(RowCount, 6) = Disagree
      .Offset(RowCount, 7) = StronglyDisagree
      .Offset(RowCount, 8) = Total
      .Offset(RowCount, 9) = RecordID

     RowNumber = RowNumber + 1

    Loop

     End With
    MATSEvalSummary.Save

    End Sub

Answer 1

RecordID = Range("u" & RowNumber)中的u是否需要为q？

Sub test()
    'Variable Declaration
    Dim LastRowWithContent As Integer
    Dim Wb As Workbook

    'Inializing
    Wb = Workbook.Name("WorkbookName")

    'Testing for content
    If Cells(4, 8) <> "" Then
        'Finding the last lowest row in column H with a value
        LastRowWithContent = Cells(Rows.Count, 8).End(xlUp).Row
        'copying the contents                           pasting/Destination
        Range("H4", Cells(LastRowWithContent, 16)).Copy Wb.Worksheets("Sheet1").Range("A1:I1")
        Range("U4", Cells(LastRowWithContent, 21)).Copy Wb.Worksheets("Sheet1").Range("J1")
    End If
End Sub

如果此代码无法解决您希望完成的内容，我希望它至少会为您提供工具和知识，以便根据您的需要进行构建。

循环没有Do错误

1 个答案: