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
0
0
982
2

Ответы 2

Это не совсем то, что вы хотите, но вы можете немного изменить это и адаптировать его под свои нужды, этот код, который я использую, объединяет листы во вновь созданном, поэтому вместо того, чтобы вставлять все данные, вы можете просто скопировать и вставить диапазон, который вы хотеть:

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

Вы хотите попытаться избежать Select и Activate в своем коде.

Задайте для строки переменную, которую вы можете увеличивать на 118 каждый раз, когда вы зацикливаете (поскольку G3:T120 имеет высоту 118 строк)

myRow = 2 'This is the row variable
For Each fSheet In fSheets
    Sheets(fSheet).Range("G3").FormulaR1C1 = "=RIGHT(TRIM(CELL(""filename"")),6)"
    Windows(thisFile).Sheets(thisTab).Range("F" & myRow & ":S" & myRow + 117).Value = Sheets(fSheet).Range("G3:T120").Value
    myRow = myRow + 118

    'Activate Projections_TY.xlsx
Next fSheet

Другие вопросы по теме