从可见单元格设置动态范围

Question

我有一些代码，其中我试图根据另一个(主)工作簿中单元格的内容对csv文件中的数据集进行排序。然后基于这种排序，在第一列和第六列之间复制可见单元格的范围，但最后一行是动态的，因此该范围将是动态的。然后将此动态范围粘贴到主工作表中，这将允许我在此数据集上进行进一步的工作。

似乎无法使排序工作或动态范围工作。我已经尝试了以下代码的各种变体，并正在寻找一些灵感。

Sub Get_OA_Data()

'Find OA data from source SQL file and copy into serial number generator 
Dim ws As Worksheet
Dim wkb2 As Workbook
Dim ws2 As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

'This section sets the workbooks and worksheets to be used for this macro
Set ws = ThisWorkbook.Worksheets("Data Entry")
Set wkb2 = Workbooks.Open("\\srvabdotfpr08\PC_APPS\forum\Gateshead Serialisation\sys_serialisation1.csv")
Set ws2 = wkb2.Worksheets("sys_serialisation1")
Set rng2 = ws.Range("F6")

'   This line deletes any content of the cannot assign serial number added previously
ws.Range("I6:I7").ClearContents

'This hides all rows which do not match the desired OA number (found in rng2)
For Each Cell In ws2.Range("A1").End(xlDown)
    If Left(Cell.Value, 6) <> rng2.Value Then
        Cell.EntireRow.Hidden = True
    End If
Next Cell

Set StartCell = ws2.Range("A1")
LastRow = StartCell.SpecialCells(xlCellTypeVisible).Row
LastColumn = StartCell.SpecialCells(xlCellTypeVisible).Column

'This section selects and copies the visible range from csv file into serialisation generator
Set rng = ws2.Range(StartCell.ws2.Cells(LastRow, LastColumn))
    rng.Copy
    ws.Activate
    ws.Range("D12").Select
    Selection.PasteSpecial 'Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False     

End Sub

我已经买了几本书，但我的书中没有一本对这个问题有帮助，任何帮助都不胜感激。

附言:我使用了非常相似的代码和特定的设置范围，它工作得很好，但这一个让我感到困惑。数据集也可能有问题-这就是为什么我在代码中有左边的公式(但这似乎工作正常)。

Answer 1

试试..。

Option Explicit

Sub Get_OA_Data()

Dim wkb2 As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim rng As Range, xCell As Range
Dim LR As Long, LC As Long, LR2 As Long

Set ws = ThisWorkbook.Worksheets("Data Entry")
Set wkb2 = Workbooks.Open("\\srvabdotfpr08\PC_APPS\forum\Gateshead Serialisation\sys_serialisation1.csv")
Set ws2 = wkb2.Worksheets("sys_serialisation1")

ws.Range("I6:I7").ClearContents
LR2 = ws2.Range("A" & ws.Rows.Count).End(xlUp).Row

For Each xCell In ws2.Range("A1:A" & LR2)
    xCell.EntireRow.Hidden = Left(xCell.Value, 6) <> ws.Range("F6")
Next xCell

LR = ws2.Range("A" & ws.Rows.Count).End(xlUp).Row
LC = ws2.Cells(1, ws.Columns.Count).End(xlToLeft).Column

Set rng = ws2.Range(ws2.Cells(1, 1), ws2.Cells(LR, LC))
    rng.SpecialCells(xlCellTypeVisible).Copy
    ws2.Range("D12").PasteSpecial xlPasteValues

End Sub