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

Question

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.

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

Answer 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

Answer 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