I am new using macro of Excel, and this is the first time I ask a question here.
I did some research here about this problem, but still can't solve it.
I have several sheets named :page 1, page 2, etc, and I want to copy the data in specific range and paste them to the sheets named "ULD".
When I run the macro in page 1, everything works perfect. But when I run it in page 2 or other sheet, the new data will paste and replace the data pasted from page 1.
The following is my vba code:
Sub test()
Dim ws As Worksheet
Set ws = Sheets("ULD")
'Only Copy Visible Cells'
Range("L3:L100").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("ULD").Activate
For Each cell In ws.Range("I4:I10").Cells
If IsEmpty(cell) = True Then cell.Select.Paste: Exit For
Next cell
End Sub
Besides, I want the data being paste only value, how should I write the code?
There is some confusion, this is how I interpret what you are trying to do.
Sub test2()
Dim ws As Worksheet, LstRw As Long
Set ws = Sheets("ULD")
With ws
LstRw = .Cells(.Rows.Count, "I").End(xlUp).Row
End With
'Only Copy Visible Cells'
Range("L3:L100").SpecialCells(xlCellTypeVisible).Copy
ws.Range("I" & LstRw + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = 0
End Sub
Related
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
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
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
I am kind of new with VBA and I have a problem I cannot solve and cannot find the right solutions in earlier questions. In fact it looks quite simple. I want to copy a range in worksheet with the name "Blad3" and paste the values in in worksheet with the name "Blad1". This is what I made and where does it go wrong?
ActiveSheet.Cells(dattel, 4).Select
ActiveCell.Range("A1:J1").Copy
Sheets("Blad1").Select
Cells(8 + aantkk, 6).Select
ActiveSheet.Unprotect
' ActiveCell.PasteSpecial xlPasteValues
Selection.PasteSpecial Paste:=xlValue
' ActiveSheet.Paste
ActiveSheet.Protect
First, the real answer to your dilemma is to protect the worksheet with the UserInterfaceOnly:=True parameter so that you do not have to Unprotect it to write values using VBA code.
Run this once.
sub protectBlad1FromUser()
worksheets("Blad1").unprotect
worksheets("Blad1").protect UserInterfaceOnly:=True
end sub
Now you can do anything you want to the Blad1 worksheet in VBA while protecting it from the user.
As to your original code, it is confusing. If .Cells(dattel, 4) is D4 on the Blad3 worksheet then ActiveCell.Range("A1:J1").Copy doesn't copy A1:J1; it copies D4:M4. In any event, direct value transfer is a more efficient method of transferring values than Copy, Paste Special, Values.
dim rng as range
set rng = worksheets("blad3").cells(dattel, 4).resize(1, 10) '<~~ figure out what this is supposed to be
with worksheets("Blad1")
.cells(8 + aantkk, 6).resize(rng.rows.count, rng.columns.count) = rng.value
end with
Would this work for you?
Sheets("Blad3").Range("A1:J1").Copy
Sheets("Blad1").Range("A1:J1").PasteSpecial Paste:=xlValue
I tested it on a new workbook and it seemed to work just fine.
May be try this
Sub Demo()
Dim srcSht As Worksheet, destSht As Worksheet
Dim rng As Range
Set srcSht = ThisWorkbook.Sheets("Blad3") 'this is source sheet
Set destSht = ThisWorkbook.Sheets("Blad1") 'this is destination sheet
With destSht
.Unprotect 'unprotect sheet Blad1
Set rng = srcSht.Range("A1:J1") 'set range to copy
.Cells(8 + aantkk, 6).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 'paste only values
.Protect 'protect sheet Blad1
End With
End Sub
SELECT and ACTIVATE should be avoided. See this for details.
Hi I have code which is meant to
Loop through all worksheets which begin with "673"
Copy all the rows which have data from row 5 onwards
Paste the entries on the next empty row in the "Colours" worksheet
I'm having the following issues:
Code only runs in the worksheet that is active
Doesn't loop through all worksheets
When it pastes in the "Colours" worksheet, it pastes directly over the headings in row 2. The first blank row is row 3 onwards and I would like the logic to paste at the next available blank row as it loops through the sheets.
Sub Consolidate()
Dim lastrow As Long
Dim report As Worksheet
Set report = Excel.ActiveSheet
For Each Sheet In ActiveWorkbook.Worksheets
If InStr(Sheet.Name, "673") > 0 Then
With report
.Range(.Cells(5, "K"), .Cells(.Rows.Count, "K").End
(xlUp)).EntireRow.Copy
End With
Worksheets("Colours").Select
lastrow = Worksheets("Colours").Cells(Worksheets("Colours").Rows.Count, 1).End(xlUp).Row
Worksheets("Colours").Cells(lastrow + 1, 1).Select
ActiveSheet.Paste
End If
Next
End Sub
Your help would be greatly appreciated.
KS is right, to get your code functioning you just need to reference the sheet. I'd started modifying it further so I'll post what I've done in totality:
Firstly I removed the 'Set report = ' line, that's not needed (alternatively you could have 'Set report' at the beginning of the loop, but it's easier to work directly 'With Sheet' as KS says).
CHANGED1 = You said it should loop through worksheets that 'begin' with 673, so this new line checks for the first three characters matching 673, rather than just looking to see if 673 appears anywhere in the sheet name.
NEW = Activates the sheet, this makes the next copy command work.
CHANGED2 = With Sheet as explained above.
CHANGED3 = You said it should copy the rows that have data from row 5 onwards (previously your code would copy rows 1-5).
Sub Consolidate()
Dim lastrow As Long
Dim report As Worksheet
For Each Sheet In ActiveWorkbook.Worksheets
If Left(Sheet.Name, 3) = "673" Then 'CHANGED1
Worksheets(Sheet.Name).Select 'NEW
With Sheet 'CHANGED2
.Range("A5", Range("A" & 65536).End(xlUp)).EntireRow.Copy 'CHANGED3
End With
Worksheets("Colours").Select
lastrow = Worksheets("Colours").Cells(Worksheets("Colours").Rows.Count, 1).End(xlUp).Row
Worksheets("Colours").Cells(lastrow + 1, 1).Select
ActiveSheet.Paste
End If
Next
End Sub
Hope this helps!
try the following code
Sub Consolidate()
Dim sheet As Worksheet, coloursSheet As Worksheet
Set coloursSheet = ActiveWorkbook.Worksheets("Colours")
For Each sheet In ActiveWorkbook.Worksheets
If Left(sheet.Name, 3) = "673" Then
sheet.Range("K5:K" & sheet.Cells(sheet.Rows.Count, "K").End(xlUp).Row).SpecialCells(xlCellTypeConstants).EntireRow.Copy _
Destination:=coloursSheet.Cells(coloursSheet.Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End Sub
it:
avoids useless selections and variables
copies non blank cells only (assuming data are "constants", i.e. not formulas)
I have an audit that is done daily. I have been asked to save the audit points to a separate sheet for review by the mgmt. team. The code is below but when I run it I get an error: Script out of range.
Sub copy1()
Dim sheet2 As Worksheet
Dim sheet10 As Worksheet
Set sheet2 = Worksheets("sheet2")
Set sheet10 = Worksheets("sheet10")
sheet2.Range("a2:g10").Copy
sheet10.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).pastspecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
It's difficult to say for sure, but it is likely that you are receiving the "Subscript out of range" error because your workbook does not have the worksheets named "Sheet2" and "Sheet10".
The following code copies data from Sheet2 and pastes the values of the data to the next available row on Sheet10.
Sub Copy2()
Dim DestinationStartingCell As Range
Dim SheetRowCount As Long
Worksheets("Sheet2").Range("A2:I29").Copy
SheetRowCount = Worksheets("Sheet10").Rows.Count '1048576 for Excel 2007 and later
Set DestinationStartingCell = Worksheets("Sheet10") _
.Range("A" & SheetRowCount).End(xlUp).Offset(1, 0)
DestinationStartingCell.PasteSpecial xlPasteValues
End Sub
You could use this code
emptyrow=WorksheetFunction.CountA(Workbooks(<workbookname>).Sheets(10).Range("A:A"))+1
Workbooks(<workbookname>).Sheets(10).Cells(emptyrow,1).pastespecial xlPasteValues
to dynamically find the first empty row in Sheet10 to paste to.
I have this code which appends data from three worksheets to a summary sheet, however on execution it is taking 12 of the 13 rows from sheet 1 and 2 and thirteen from sheet 3 to the summary I also would like this to work by sending to a summary sheet in a different workbook
Sub SummurizeSheets()
Dim ws As Worksheet
Application.ScreenUpdating = False
Sheets("Summary").Activate
For Each ws In Worksheets
If ws.Name <> "Summary" Then
ws.Range("D2:D6, D8:D15").Copy
Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp).Offset(0, 0).PasteSpecial (xlPasteValues)
End If
Next ws
End Sub
Change Offset(0,0) to Offset(1,0). What's happening is not that it's copying 12 rows, but rather that the subsequent blocks are being pasted starting at the end of the previous block. That is, the first block is pasted into D1:D13, and the second block is pasted into D13:D26. By using Offset(1,0), the second block will be pasted starting with the first empty cell (that is, D14).
You can place the results in a new workbook simply by creating it in the code and referring to it in the paste, for example:
Option Explicit
Sub SummurizeSheets()
Dim ws As Worksheet
Dim currentWB As Workbook: Set currentWB = ActiveWorkbook
Dim newWB As Workbook: Set newWB = Application.Workbooks.Add
newWB.Worksheets(1).Name = "Summary"
For Each ws In currentWB.Worksheets
ws.Range("D2:D6, D8:D15").Copy
With newWB.Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp)
If IsEmpty(.Value) Then
.PasteSpecial (xlPasteValues)
Else
.Offset(1, 0).PasteSpecial (xlPasteValues)
End If
End With
Next ws
End Sub
EDIT updated to paste into the first empty cell in column, even if that is row 1.