将数据传输到特定的Excel工作表

问题描述 投票:0回答:1

我正在尝试将数据传输到最后一行的特定工作表,但无法传输数据,但是在工作表中的某些空白单元格之后,解决数据所需的帮助正在每张工作表中传输,但不在下一个空白单元格中:

 Sub transferData()
      Application.ScreenUpdating = False
      'Dim myData As Worksheet, ItemA As Worksheet, ItemB As Worksheet, ItemC As Worksheet, ItemD As 
       Worksheet, ItemE As Worksheet
      Dim ItemName As String
      Dim price As Long, qty As Long

      Dim r1 As Long, r2 As Long, erow As Long, lastrow As Long
      r1 = 2
      r2 = 2
      Sheets(Array("Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6")).Select
      Sheets("Sheet2").Activate
      Cells.Select
      Selection.ClearContents
      Sheets(Array("Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6")).Select
      Sheets("Sheet2").Activate
      range("A1").Select
      ActiveCell.Value = "Item"
      range("B1").Select
      ActiveCell.Value = "Price"
      range("C1").Select
      ActiveCell.Value = "Quantity"

       MYDATA.Activate

      Do While Cells(r2, 1) <> ""
      ItemName = Cells(r2, 1).Value
      price = Cells(r2, 2).Value

      qty = Cells(r2, 3).Value

       p = Worksheets.Count
       For q = 1 To p
       If ActiveWorkbook.Worksheets(q).CodeName = UCase(ItemName) Then
       Worksheets(q).Activate
       erow = Worksheets(q).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
       Cells(r2, 1).Value = ItemName
      Cells(r2, 2).Value = price
       Cells(r2, 3).Value = qty
       r2 = r2 + 1


        enter code here

       End If
       Next q
       MYDATA.Activate
        Loop
       Application.ScreenUpdating = True
    End Sub
excel vba transfer
1个回答
0
投票
一些评论:

    添加一些缩进将使您的代码更易于理解
  1. 避免使用Range().Select,然后再使用ActiveCell.Value=xxx,这将非常慢。只需使用Range().Value = xxx。这适用于其他实体,例如工作表,单元格等。
  2. For...Next循环中,r2应该替换为erow,以便将您的值复制到其他工作表中。
© www.soinside.com 2019 - 2024. All rights reserved.