Question

我有两张纸，“数据1”有我的所有数据，“附表1”是需要填写的表格。我想要做的是遍历“数据1”中的每一行，并将列E的值放入“计划1”表中的列C中，然后仅保存“计划1”表。然后重复该过程，直到完成所有行。到目前为止，这是我所拥有的，接下来的工作我有些停滞。

   Public Sub CopyRows()
        Dim SaveSheet As Worksheet
        Sheets("Data1").Select
        ' Find the last row of data
        FinalRow = Cells(Rows.Count, 1).End(xlUp).row
        ' Loop through each row
        For x = 2 To FinalRow

        'Code here. How can I go through all the rows in "Data 1" and place the value of column E into column C in "Schedule 1"

     'Save just the sheet
    Set SaveSheet = ActiveWorkbook.Worksheets(Data1)

     SaveSheet.SaveAs FilePath, xlXMLSpreadsheet
     SaveSheet.Name = SheetName 'I would like to put the name of values in Column A from "Data 1" sheet


        Next x
    End Sub

Answer 1

不清楚如何复制数据，但这应该给您一个开始：

Option Explicit

Public Sub CopyRows()

    Dim wsData As Worksheet, wsSchedule As Worksheet
    Dim FinalRow As Long, x As Long, wbNew As Workbook, nm

    Set wsData = ThisWorkbook.Sheets("Data1")
    Set wsSchedule = ThisWorkbook.Sheets("Schedule 1")

    FinalRow = wsData.Cells(Rows.Count, 1).End(xlUp).Row

    For x = 2 To FinalRow

        'copy over some data
        nm = wsData.Cells(x, "E").Value
        wsSchedule.Range("C1").Value = nm
        wsSchedule.Copy 'create a new workbook with the copied sheet
        Set wbNew = ActiveWorkbook 'the new workbook with the copied sheet
        'save the new workbook in an "exports" subfolder in the same
        '   folder as this workbook
        wbNew.SaveAs ThisWorkbook.Path & "\Exports\" & nm & ".xlsx"
        wbNew.Close False

    Next x

End Sub

VBA将一张纸循环到下一张纸

1 个答案: