Excel复制范围并粘贴到可用的特定范围并打印

Question

I would like to copy a range in one sheet and paste it as a value in another sheet, but just in a specific range in the next available cell in column B. Starting from B4 to B23 only.

I changed some code I found online but it's not working for me in finding the next available row. After I run the macro the first time, when I run it again and again it does nothing, and it's not working in pasting only the values either.

I tried saving the file before running the Macro again, but still it's not working.

At the end, when the range in the Print sheet is full, I would like a message box asking me to select one of the printers (not the default) on one of my servers (specifying the server path in the code like \\a_server_name) and print this Print Sheet only, or clear the records in the range in the Print Sheet, or save only the Sheet Print in a new file (SaveAs) to a location I can choose on one of my servers (specifying the server path in the code \\a_server_name) or simply do nothing and end the sub.

Thank you.

Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet

Set copySheet = Worksheets(“Data”)
Set pasteSheet = Worksheets("Print”)

copySheet.Range("J11:Q11").Copy
pasteSheet.Range("B4:I23").End(xlUp).Offset(1,0)
.PasteSpecial.xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True

Answer 1

This will set the values equal to each other without copying/pasting.

Option Explicit

Sub Testing()

Dim wsC As Worksheet: Set wsC = ThisWorkbook.Sheets("Data")
Dim wsP As Worksheet: Set wsP = ThisWorkbook.Sheets("Print")

Dim LRow As Long
LRow = wsP.Range("B" & wsP.Rows.Count).End(xlUp).Offset(1).Row

wsP.Range("B" & LRow).Resize(wsC.Range("J11:Q11").Rows.Count, wsC.Range("J11:Q11").Columns.Count).Value = wsC.Range("J11:Q11").Value

End Sub

---

Modifying your code - and reducing to minimal example

Sub test()

Dim copySheet As Worksheet: Set copySheet = Worksheets("Data")
Dim pasteSheet As Worksheet: Set pasteSheet = Worksheets("Print")

copySheet.Range("J11:Q11").Copy
pasteSheet.Range("B" & pasteSheet.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

End Sub

Answer 2

From what i can gather, you want to copy 8 cells and paste all 8 cells to 20 rows, starting at B4. You are not clear on how you want to rerun the macro, it will just write over the data you just pasted.

The first code will copy the 8 cells into the 20 rows

With ThisWorkbook
        Sheets("Data").Range("J11:Q11").Copy
        Sheets("Print").Range("B4:I23").PasteSpecial Paste:=xlPasteValues
End With

This second code uses a for loop to accoplish the same task, but it also will write over the previously pasted data.

Dim i As Long
    With ThisWorkbook
        For i = 4 To 23
            Sheets("Data").Range("J11:Q11").Copy
            Sheets("Print").Cells(i, 2).PasteSpecial Paste:=xlPasteValues
        Next i
    End With

If you want to be able to reuse the macro, you will have to modify the range to be copied that allows you to select the range you want to copy. Maybe a variable that allows a user input with a InputBox .

Edit:

Dim lRow As Long
lRow = Sheets("Print").Cells(Rows.Count, 2).End(xlUp).Row

    With ThisWorkbook
            Sheets("Data").Range("J11:Q11").Copy
            Sheets("Print").Cells(lRow, 2).Offset(1).PasteSpecial Paste:=xlPasteValues
    End With

Edit #3

With ThisWorkbook
    Dim lRow As Long
    lRow = .Sheets("Print").Range("B" & Rows.Count).End(xlUp).Row
        Sheets("Data").Range("J11:Q11").Copy
        Sheets("Print").Cells(lRow, 2).Offset(1).PasteSpecial Paste:=xlPasteValues
End With