使用VBA将数据从一个工作表移动到另一个工作表

4 回答

• 1

  我建议将这3个子组合成一个可以通过将工作表作为参数重复使用的子组件：

  Sub sbCopyRangeToAnotherSheet(ToSheet As Worksheet)
      Dim LastUsedRow As Long
  
      With Sheets("Master")
          LastUsedRow = .UsedRange.Row + .UsedRange.Rows.Count - 1
          .Range("B10:M" & LastUsedRow).Copy ToSheet.Range("B9")
      End With
  
      Application.CutCopyMode = False
  End Sub
  

  然后你可以为任何工作表名称运行此子目录

  Sub test_1()
      sbCopyRangeToAnotherSheet Sheets("test_1")
      'and for the second sheet
      sbCopyRangeToAnotherSheet Sheets("test_2")
  End Sub
  

  回复于 2024-04-30T02:28:20+08:00
• 0

  我建议要么使用Worksheet对象的 UsedRange 属性，

  或者在工作表上定义命名范围，随着工作表上的数据增长自动扩展，如： =OFFSET($A$1,0,0,COUNTA($A:$A),1)

  回复于 2024-04-30T02:28:20+08:00
• 1

  您可以使用此循环宏

  Sub CopyAll()
      Dim src As Range, dest
      With Worksheets("Master") ' set the source range
          Set src = .Range("B10:M" & .Cells(.Rows.Count, "B").End(xlUp).Row)
      End With
      For Each dest In Array("test_1", "test_2", "test_3") ' loop on destination sheets
          src.Copy Worksheets(dest).Range("B9")
      Next
  End Sub
  

  回复于 2024-04-30T02:28:20+08:00
• -1

  我认为复制数据的最佳方法是使用一个数字填充的数组 .

  • 创建确切的数组

  • 从主表中填写数据

  • 粘贴数据 .

  在这种情况下，你不必担心新行，因为你使用dinamic数组 . 看下面的一些例子 .

  Sub sbCopyRangeToAnotherSheet()
  Sheets("Master").Select
  Dim RowNum as integer 
  For i = 0 To 250000 'Count all rows
      If IsEmpty(Cells(i + 10, 2)) = False Then
          RowNum = RowNum + 1 'Count all rows which have data in it's second column
      Else
          Exit For
      End If
  Next
  ReDim myData(RowNum - 1, 12) As String 'create array
  For i = 0 To RowNum - 1 'fill array, with data
      For j = 0 to 12
      myData(i, j) = Cells(i + 10, j+2) '+10 because you said B**10**
                                        '+2 because you said **B**10
      Next
  Next
  
  Sheets("test_1").Activate
  For i = 0 To RowNum - 1 'fill array, with data
      For j = 0 to 12
      Cells(i + 10, j+2) = myData(i, j) 'Fill cells with data
      Next
  Next
  End Sub
  

  回复于 2024-04-30T02:28:20+08:00