☰

无法复制列中的所有数据-excel VBA

tag-icon • tag-icon microsoft-excel vba
无法复制列中的所有数据-excel VBA

我试图通过 VBA 复制特定列中的所有数据并将其粘贴到工作簿中的另一张表中，因为这将在多列中重复。出于某种原因 - 并非所有数据都会被传输，因为有些数据是空白的。我在 VBA 中的代码如下。

我是 VBA 的新手，感谢大家的帮助，谢谢！

wsRawT 和 wsDetI 是我为指定工作表定义的变量。

wsRawT.Select
    range("AU1").Select
    ActiveCell.Offset(1, 0).range("A1").Select
    range(Selection, Selection.End(xlDown)).Select
    Selection.copy

wsDetI.Select
    range("A1").Select
    ActiveCell.Offset(1, 0).range("A1").Select
    ActiveSheet.Paste

答案1

Sub test()
    Dim wsRawT As Worksheet, wsDetI As Worksheet
    Set wsRawT = ThisWorkbook.Sheets("Sheet1")
    Set wsDetI = ThisWorkbook.Sheets("Sheet2")

    wsRawT.Range(wsRawT.Cells(2, 47), wsRawT.Cells(wsRawT.UsedRange.Rows.Count, 47)).Copy _
           Destination:=wsDetI.Cells(2, 1)

End Sub

附言：Range("AU2").Column = 47

答案2

用户窗体可用于复制列。用户窗体包含两个列表框。Sheet1 上的列标题列在第一个列表框中。在列表框之间，单击按钮可将项目从列表框 1 移动到列表框 2。使用高级筛选方法将从列表框 2 中选择的列复制到其他工作表 (Sheet2)。

Private Sub CommandButton1_Click()
Dim FirstCell, LastCell As Range
Dim basliklar As Integer
Dim baslangic_satiri As Long
Sheets("report").Select
If ListBox2.ListCount = 0 Then
MsgBox "You don't choose filter field "
Exit Sub
End If
ProgressDlg.Show 'Progress Bar

  Set LastCell = Sheets("database").Cells(Sheets("database").Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
      Sheets("database").Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
  Set FirstCell = Sheets("database").Cells(Sheets("database").Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows, _
      SearchDirection:=xlNext, LookIn:=xlValues).Row, _
      Sheets("database").Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _
      SearchDirection:=xlNext, LookIn:=xlValues).Column)

For basliklar = 0 To ListBox2.ListCount - 1
baslangic_satiri = 2
Sheets("report").Cells(baslangic_satiri - 1, basliklar + 1) = ListBox2.List(basliklar, 0)

Sheets("database").Range(FirstCell, LastCell).AdvancedFilter _
    Action:=xlFilterCopy, CriteriaRange:=Sheets("database").Range(FirstCell, LastCell), _
    CopyToRange:=Sheets("report").Cells(baslangic_satiri - 1, basliklar + 1), _
    Unique:=False
Next
Sheets("report").Columns.EntireColumn.AutoFit
CommandButton6.Enabled = True
End Sub

在此处输入图片描述

示例文件

相关内容