VBA 循环将每一行数据粘贴到模板，并另存为？答案

【问题标题】：VBA loop to paste each row of data to a Template, and save-as?VBA 循环将每一行数据粘贴到模板，并另存为？
【发布时间】：2023-02-23 12:38:51
【问题描述】：

源报告和输出模板非常干净（并且有相同的列），所以这真的不应该像我做的那么难。

我有大约 100 行数据透视表销售数据，想将每一行（标题除外）复制/粘贴到标准模板文件，并按公司名称保存。

源数据文件 (ApportionmentData.xlsm) 包含 A 行中的数据：AJ。选项卡名称是 [数据]。

“A”列包含公司名称（每个都是唯一的）。 “B:AI”列包含销售数据（每个列标题都是唯一的） “AJ”列包含我已连接并希望用于另存为的文件名。

目标文件 (Template.xlsm) 包含一个名为 [TBSource] 的选项卡，我想在另存为和循环之前粘贴一行 (TO ROW 2)。我已经使两个选项卡的标题保持一致，以尽量降低复杂性，因此我只需要在第一次迭代时复制/粘贴第 2 行。

粘贴到 [TBSource] 的第 2 行后，我想按“AJ2”列中的值另存为，然后继续将 [Data] 的第 3 行复制/粘贴到下一个模板（第 2 行）。

目标是为 [Data] 选项卡的每一行创建一个单独的文件。

子创建组织者（）

Dim wbstart As Workbook, wbtarget As Workbook 'You need As for each one, otherwise they are variants
Dim strPath As String
Dim cell As Range
Dim i As Long
strPath = ActiveWorkbook.Path
Application.ScreenUpdating = False

Set wbstart = ActiveWorkbook
Set wbtarget = Workbooks.Open("C:\Users\Desktop\Macro\Template Organizer\Template.xlsm")
With wbstart.Sheets("Data")
    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(i, 1), .Cells(i, 36)).Copy Destination:=wbtarget.Sheets("TBSource").Range(wbtarget.Sheets("TBSource").Cells(i, 1), wbtarget.Sheets("TBSource").Cells(i, 36))
        wbtarget.SaveAs Filename:=strPath & "\" & .Cells(i, 36).Value
    Next i
End With

Application.ScreenUpdating = True
MsgBox "Finished"

结束子

我当前的版本运行循环，但对于每次迭代，它都会继续增长（而不是粘贴一行）。我想我很接近这里但可以使用第二个意见！

【问题讨论】：

标签： excel loops

【解决方案1】：

我想到了！兴高采烈！此部分应反映您要粘贴数据的行，“2”而不是“i”。

目的地：=wbtarget.Sheets("TBSource").Range(wbtarget.Sheets("TBSource").Cells(2, 1), wbtarget.Sheets("TBSource").Cells(2, 36))

【讨论】：