Question

我有一个输入工作簿，我将从中复制第一行并将其粘贴到另一个excel工作簿（wbET）中。这是我必须为输入工作簿中的行数。

我有第一行的代码。我必须为所有行做这件事。任何人都可以帮助我

代码：

Option Explicit


    Dim wbIP As Workbook
    Dim wbJT As Workbook
    Dim wbET As Workbook
    Dim mypathET As String
    Dim mypathJT As String
    Dim mypathIP As String
    Dim vals As Variant

 Sub tool()

        mypathET = "C:\Documents and Settings\madinenih\Desktop\PremiumCalcutionTool"
        mypathJT = "C:\Documents and Settings\madinenih\Desktop\Japancalculationtool"
        mypathIP = "C:\Documents and Settings\madinenih\Desktop\A01"

        '
        'Set wbJT = Workbooks.Open(Filename:=mypathJT)
        Set wbIP = Workbooks.Open(Filename:=mypathIP)

        wbIP.Activate
        'Rows("1:1").Select
        'Selection.Copy
        wbIP.Sheets("A01").Range("A1:IU1").Copy
        Set wbET = Workbooks.Open(Filename:=mypathET)
        wbET.Activate
        wbET.Sheets("Input file data").Range("A3:IU3").PasteSpecial

        'wbET.Activate
        Application.Run (wbET.Name & "!run1")

        Call Createexcels

        wbIP.Activate
        'Rows("1:1").Select
        'Selection.Copy
        wbIP.Sheets("A01").Range("A1:IU1").Copy
        Set wbJT = Workbooks.Open(Filename:=mypathJT)
        wbJT.Activate
        wbJT.Sheets(2).Range("A5:IU5").PasteSpecial
        'Application.Run (wbJT.Name & "!run1")
        Call openexcel

        Call compare

 End Sub

Sub Createexcels()
    Dim NewBook As Workbook
    vals = "test"

        Set NewBook = Workbooks.Add
        NewBook.SaveAs Filename:=vals
        'Workbooks("Whatever.xlsx").Worksheets("output").Range("A1:K10").Copy
        'NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteValues)
        ' NewBook.Worksheets("Sheet1").Activate
        wbET.Activate
        wbET.Sheets("Calculation").Range("L2:L41").Copy
        NewBook.Worksheets("Sheet1").Activate
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        wbET.Activate
        wbET.Sheets("Calculation").Range("L44:L61").Select
        Application.CutCopyMode = False
        Selection.Copy
        Windows(vals).Activate
        Range("A44").Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        wbET.Activate
        wbET.Sheets("Calculation").Range("L64:L69").Select
        Application.CutCopyMode = False
        Selection.Copy
        Windows(vals).Activate
        Range("A63").Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        wbET.Activate
        wbET.Sheets("Calculation").Range("L72:L81").Select
        Application.CutCopyMode = False
        Selection.Copy
        Windows(vals).Activate
        Range("A70").Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Columns("A:A").EntireColumn.AutoFit
        NewBook.Save

    End Sub

Answer 1

您需要遍历输入工作表中的所有行。首先，您需要在输入表中获取最后一行。

' use this in your loop.  It looks like you are starting on row 3 of your input sheet.    
Dim LastRow as Long
LastRow = Activesheet.Cells(Activesheet.Rows.Count, 2).End(xlUp).Row

Dim i as Long
For i = 3 to LastRow
    ' Code to copy each row goes here
    ' You will need to change how you are referencing your range
    wbET.Sheets("Input file data").Range("A" & i & ":IU" & i).PasteSpecial
Next i

Answer 2

您需要找到最后一行和最后一列

使用最后一行和列作为参考，您可以轻松制作复制粘贴方法

使用VBA将excel工作簿的每一行复制到另一个excel工作簿

2 个答案: