使用VBA將excel工作簿的每一行復制到另一個excel工作簿

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

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

使用最后一行和最后一列作為參考，您可以輕松實現復制粘貼方法