简体   繁体   中英

Copy & Paste whole line automatically with VBA (excel)

Sheets("Source").Select
Rows("1:1").Select
Selection.Copy
Sheets("Print").Select
Rows("1:1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Sheets("Source").Select
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Print").Select
Rows("1:1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

So, this is the sample code. What I want to do is Copy each line from Source Sheet and Paste to 1:1 rows in Print Sheet automatically.

The range is different every time. It'll be great if the code works as rows number.

[2nd question] Alright, Now I got new problem. After I execute the code, Excel freeze.

here's the new code.

Dim i As Long 'i - Number of rows in Source list
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
For i = 1 To NumRows
    Worksheets("Source").Rows(i).Copy
    Worksheets("Print").Rows("1:1").PasteSpecial Paste:=xlPasteValues
    Worksheets("Print").PrintOut Copies:=1, Collate:=True, _
            IgnorePrintAreas:=False
Next

You can use a FOR loop sequence but i'm not sure of what you want with the program. Can you please share some more details about it?

If i understand you correct, you must use construction like this:

Dim i as long 'i - Number of rows in Source list
i = 100 'for example
Worksheets("Source").Rows("1:" & i).Copy 
Worksheets("Print").Rows("1:1").PasteSpecial Paste:=xlPasteValues

Let us assume that Source sheet structure like the image below:

在此处输入图片说明

and Print sheet is empty.

you could try:

Option Explicit

Sub test()

    Dim wsSource As Worksheet, wsPrint As Worksheet
    Dim rngCopy As Range
    Dim LastRow As Long, LastColumn As Long

    Set wsSource = ThisWorkbook.Worksheets("Source")
    Set wsPrint = ThisWorkbook.Worksheets("Print")

    With wsSource

        'Find last row of column A
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        'Find last column or row 1
        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        'Set range to copy
        Set rngCopy = .Range(.Cells(2, 1), .Cells(LastRow, LastColumn))

    End With

    rngCopy.Copy wsPrint.Range("A1")

End Sub

Result:

在此处输入图片说明

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM