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

I have a input workbook, from which I will copy first row and paste it in another excel workbook (wbET). This I have to do for the number of rows in my input workbook.

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

I have code for first row. I have to do it for all the rows. can any one help me out

我有第一行的代码。我必须为所有行做这件事。谁能帮我吗

code:

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

2 个解决方案

#1

You need to loop through all of the rows in your Input worksheet. To start you need to get the last used row in our input sheet.

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

' 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

#2

you need to find the last row and last column

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

using last row and column as reference, you can make the copy paste method easily

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

#1