合并具有下拉列表的工作表

Question

我有一个由180个工作表组成的工作簿。每个工作表都有前9行和列A1：Z1，其中包含我不需要的信息。

其余的工作表都有我确实需要的数据，并希望将其附加到一个工作表中。问题在于每个工作表都嵌入了其中的下拉选择。已经做出了选择，我需要用选择的选择附加床单。

一直试图运行一个VBA脚本，但没有成功。任何帮助是极大的赞赏。谢谢你

当前代码我用来删除几张床单的顶部行，仅删除但不附加。而且我插入了表格，但是有180张纸是不可能的。

Sub remove_rows()''remove_rows Macro'

'

`Rows("1:10").Select`
`Selection.EntireRow.Hidden = False`
`Range("D20").Select`
`Rows("1:9").Select`
`Range("A9").Activate`
`Selection.Delete Shift:=xlUp`
`Sheets("BioME-Box- (2)").Select`
`Rows("1:15").Select`
`Selection.EntireRow.Hidden = False`
`Rows("1:9").Select`
`Range("A9").Activate`
`Selection.Delete Shift:=xlUp`
`Sheets("BioME-Box- (3)").Select`
`Rows("1:13").Select`
`Selection.EntireRow.Hidden = False`

Rows("1:9").Select Range("A9").Activate Selection.Delete Shift:=xlUp

Answer 1

听起来您是在谈论验证列表，因为您的"下拉"列表。如果是这样，那么他们可能会从其他地方的另一个范围内获得选择。因此，如果删除验证列表正在使用的范围，则其所有选项都会消失。我不知道这是否是您的问题。但是，您可以复制验证列表并仅粘贴其值，而不是整个列表。

Sub Macro1()
    Range("D3").Select '    This is the validation list
    Selection.Copy
    '   Change "SomeOtherRangeHere" to any cell you want to
    Range("SomeOtherRangeHere").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

Answer 2

尝试这个。确保将Mainws更改为您要复制的工作表。我使用了Sheet1，但您可能正在使用另一个。在此子中，它将所有床单的第9行下方的所有内容都复制到Sheep1中的第一个可用行。

Sub Macro1()
Dim ws As Worksheet, mainWS As Worksheet
Dim wsLastRow As Long, mainWSlastRow As Long, wsLastCol As Long
    Set mainWS = Sheet1 ' Change this to the sheet you are copying everthing to
    For Each ws In ThisWorkbook.Worksheets
        def = mainWS.Name
        abc = ws.Name
        If ws.Name <> mainWS.Name Then ' Make sure to not copy from the sheet yuo are copying to
            wsLastRow = ws.UsedRange.Rows.Count
            wsLastCol = ws.UsedRange.Columns.Count
            On Error Resume Next
            mainWSlastRow = Sheet1.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
            If Err.Number = 91 Then
                mainWSlastRow = 1
                On Error GoTo 0
            End If
            ws.Range("A10:" & Chr(wsLastCol + 64) & wsLastRow).Copy Destination:=mainWS.Range("A" & mainWSlastRow + 1)
        End If
    Next ws
    Set mainWS = Nothing
    Set ws = Nothing

End Sub