列内のすべてのデータをコピーできません - Excel VBA

Question

特定の列のすべてのデータをコピーし、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

Answer 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

Answer 2

ユーザーフォームは列のコピーに使用できます。ユーザーフォームには 2 つのリストボックスが含まれています。sheet1 の列見出しは最初のリストボックスにリストされます。リストボックス間では、ボタンをクリックすると項目が listbox1 から listbox2 に移動します。listbox2 で選択された列は、高度なフィルター メソッドを使用して他のシート (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

サンプルファイル