从工作表复制 n 行并附加到当前工作簿和工作表答案

【问题标题】：Copy n Rows from Sheet and append to current Workbook&Sheet从工作表复制 n 行并附加到当前工作簿和工作表
【发布时间】：2019-08-09 13:31:17
【问题描述】：

我正在尝试遍历给定目录中的所有工作簿，打开工作簿，遍历工作表，复制每个工作表的前 14 行并将它们附加到当前打开的工作表。

到目前为止，我已经让 sheet.copy 将工作表植入工作簿中，但我错过了最后一步：将每张工作表的前 14 行复制到当前打开的工作表中。应该列出行的工作表最初是空的，以防万一。

Sub GetSheets()

Path = "F:\_Projekttiming\Wochenplanung\Einzelne_Dateien\"
Filename = Dir(Path & "*.xlsx")

Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

  For Each Sheet In ActiveWorkbook.Sheets
    Sheet.Copy After:=ThisWorkbook.Sheets(1)

  Next Sheet

  Workbooks(Filename).Close
  Filename = Dir()
Loop

End Sub

非常感谢您对此的任何帮助:)

【问题讨论】：

标签： excel vba

【解决方案1】：

你不需要复制表格，只需复制14行的内容（你真的需要整行吗？）

您可能需要调整目标工作表，我假设它是工作簿中包含宏的第一张工作表。

养成声明变量并将对象分配给它们的习惯也是一个好主意（例如wb），这样您就可以更有效地引用它们。

Sub GetSheets()

Dim wb As Workbook, Path As String, FileName, sheet As Worksheet

Path = "F:\_Projekttiming\Wochenplanung\Einzelne_Dateien\"
FileName = Dir(Path & "*.xlsx")

Do While FileName <> ""
    Set wb = Workbooks.Open(FileName:=Path & FileName, ReadOnly:=True)
    For Each sheet In wb.Worksheets
        sheet.Range("A1").EntireRow.Resize(14).Copy ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp)(2)
    Next sheet
    wb.Close
    FileName = Dir()
Loop

End Sub

【讨论】：