时间戳

首页 > 解决方案 > Excel VBA循环通过选项卡复制并粘贴到另一个文件中的一个单独的文件中......

vba - Excel VBA循环通过选项卡复制并粘贴到另一个文件中的一个单独的文件中......

问题描述

我试图找出一种方法来编写一个宏，该宏通过具有特定名称的工作簿中的选项卡，并将特定范围的数据复制并粘贴到另一个下方的新文件中......

我尝试了以下（见下面的代码......）

这显然不起作用，因为它将所有数据的数据粘贴在同一个单元格 F2 中......任何人都可以建议在粘贴数据之后进入下一个单元格的最佳方法，例如，如果第一个数据（源“10000” ) 粘贴在单元格 F2:R30 我希望将（源“20100”）的下一个数据粘贴到单元格 F31:R62 的正下方，依此类推...

任何帮助将不胜感激

谢谢

Option Explicit

Sub ImportData()
Dim fPath As String
Dim fName As String
Dim thisFile As String
Dim thisTab As String
Dim fSheets As Variant
Dim fSheet As Variant
'
'
fPath = "C:\CliffTemp\ProjectionsFile_TY.xlsx"
fName = "Projections_TY.xlsx"
thisFile = "Projections_ReportingTEMP.xlsm"
thisTab = "Projections"
'

fSheets = Array("10000", "20100", "30101", "40200", "50300")

    'Update Projections_ReportingTEMP file

    'Open Projections_TY file: Projections_TY.xlsx
    Application.EnableCancelKey = xlDisabled 'fixes the "Code error msg..
    Workbooks.Open Filename:=fPath, UpdateLinks:=False
    Windows(fName).Activate

    For Each fSheet In fSheets
    Sheets(fSheet).Select


    Range("G3").Select
    ActiveCell.FormulaR1C1 = "=RIGHT(TRIM(CELL(""filename"")),6)"
    Range("G3:T120").Select
    Selection.Copy
    Windows(thisFile).Activate
    Sheets(thisTab).Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Activate Projections_TY.xlsx
    Windows(fName).Activate

    Next fSheet

标签： vbaexcel

解决方案

这不完全是您想要的，但是您可以对其进行一些修改并根据自己的需要进行定制，我使用的这段代码将表格合并到新创建的表格中，因此您无需粘贴整个数据，只需复制粘贴您的范围想：

Sub ConsolidateSheets()
    Dim i As Long
    Dim cell As Range
    Dim WS As Worksheet
    Dim WS_consolidated As Worksheet
    Dim WB As Workbook
    Set WB = ActiveWorkbook

    Set WS_consolidated = WB.Worksheets.Add
    WS_consolidated.Name = "Consolidated"

    For Each WS In WB.Worksheets
        If WS.Name <> "Consolidated" Then
            WS.Range("A1").CurrentRegion.Copy
            If WS_consolidated.UsedRange.Address = "$A$1" Then
                WS_consolidated.Range("A1").PasteSpecial (xlPasteValues)
            Else
                With WS_consolidated
                    Set cell = .Cells(.UsedRange.Rows.Count + 1, 1)
                End With
                cell.PasteSpecial (xlPasteValues)
            End If
        End If
    Next
End Sub

推荐阅读