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

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

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行下面的所有内容，并将它们粘贴到sheet1中的第一个可用行。

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

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

2 个答案: