Excel VBA - "Copy/Paste" pastes only value of selected range - vba

I am writing a macro that opens a file selected by the user, copies all the data inside it and pastes it in another workbook already opened. The snippet of code looks like this :
Windows(fileToClose).Activate
ActiveSheet.Range("A1").EntireRow.Delete
ActiveSheet.Range("A1:G1", Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.Close SaveChanges:=False
Windows(fileKeepOpen).Activate
Sheets("DATA").Select
ActiveSheet.Range("B2:H2", Selection.End(xlDown)).Clear
ActiveSheet.Range("B2").Select
ActiveSheet.Paste
It works good execpt for the first column of the selection : it only takes the first value and pastes it everywhere in the destination column. For instance, if the first cell in the first column of the selection contains "A" and the second cell contains "B", the destination column will be filled with "A"s. But for the second column, no problem whatsoever.
PasteSpecial doesn't work at all also (each column has a different data format, and it looks like Excel doesn't want me to paste everything as values, since it keeps giving me a 1004 error).
Any ideas ?

I don't know what kind of data you have, but this should do the trick :
Dim RS As String
RS = "A1:G" & Workbooks(fileToClose).ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox RS
Workbooks(fileToClose).ActiveSheet.Range("A1").EntireRow.Delete
Workbooks(fileKeepOpen).Sheets("DATA").Range("B2:H2").End(xlDown).Clear
Workbooks(fileToClose).ActiveSheet.Range(RS).Copy Destination:=Workbooks(fileKeepOpen).Sheets("DATA").Cells(2, 2)
Workbooks(fileToClose).Close SaveChanges:=False
If it's not working let us know why! ;)

Related

VBA Runtime Error 1004 “Application-defined or Object-defined error” when setting Range in macro

I'm going to preface this by saying that I am very new to VBA and this is my first project with it however, I'm trying quite hard because otherwise it is manual copy paste ~200 times.
Unfortunately, for a first project it has been difficult.
EDITED FOR CLARITY (HOPEFULLY): The main idea is that I need to start at the beginning of a drop down list, copy the first string listed, then paste that string down the column. This changes the numerical data adjacent to the right. I then want to select this newly changed numerical data and copy and paste it to a different sheet in the same workbook in the first blank space in column F. I then want the code to iterate through the drop down list and do this for all 51 strings in the drop down. However it needs to paste offset by 3 columns for each iteration to copy the data to the correct column in the other sheet.
Here is my code thus far
Option Explicit
Sub PtComp()
'
' PtComp Macro
'
'
Dim List1 As String
Dim Range1 As Range
Dim Line1 As Range
Dim i As Integer
Dim Begin As Range
ActiveWorkbook.Sheets("Sample Data Summary").Activate
List1 = Selection
Set Range1 = Evaluate(ActiveSheet.Range(List1).Validation.Formula1)
For Each Line1 In Range1
Selection.Copy
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
ActiveSheet.Selection.Copy
ActiveWorkbook.Sheets("Pt Comparison").Activate
Begin = ActiveSheet.Range("F1").End(xlDown).Offset(-1, 0)
For i = 0 To 148 Step 3
Begin.Offset(0, i).Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues
Next i
Next Line1
End Sub
It is highlighting this line
Set Range1 = Evaluate(ActiveSheet.Range(List1).Validation.Formula1)
Any help would be greatly appreciated. Sorry if my code is trash, like I said, first timer hoping to get better.
EDIT: Also, I looked back at older questions with the same error and thought that it was maybe because it wasn't clear what worksheet I was trying to define the range in, hence why my code is full of 'ActiveSheet' but still no luck.
Your code assumes List1 contains a valid range address, and thus that the active cell on that "Sample Data Summary" worksheet, contains a valid range address.
Apparently that isn't always the case. Search for more details on the On Error statement for ideas about how you could go about handling that situation.
You need to read up on How to avoid using Select in Excel VBA macros, and know that clipboard operations in a tight loop is pretty much the single slowest thing you can do in Excel-VBA.
Seems you want something like this:
Set Range1 = Evaluate(Selection.Validation.Formula1)
Your code blows up on Range(List1) because List1 does not contain a valid range address.

Merging from multiple worksheets into one worksheet but its format is not like the original one

I'm new into coding, so please help me.
This code is from kutools.I want to merge all the worksheets into one sheet, but the "combined" sheet should be the last of the worksheets. So I have edited some parts of the code.
when I run, it turns abnormal, it's very different if you put the combined sheets in sheets(1).
it seems the format in original sheets like font, length of column, has varied a lot. The result is like I have done "PASTE VALUE" only. It's very different if I change the destination in sheets(1).
Sorry for bad English, here's one example of my sheet, all sheets have the same format and header.
Here's the result when I combined all data in new sheets, on the last sheet named "RAW" the format has gone.
The format is very important for presenting reports in a proper presentable way to Seniors.
would you please help me for better format?
And here's the code.
Sub merge()
Dim P As Integer
Dim lastws As Worksheet
On Error Resume Next
'Sheets(1).Select
'Worksheets.Add
'Sheets(1).Name = "RAW"
'Set lastsht = After:=Worksheets(Worksheets.Count)
'Worksheets(Worksheets.Count).Select
'Worksheets.Add
'Worksheets(Worksheets.Count).Name = "RAW"
Set lastws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
lastws.Name = "RAW"
'nice udah bisa
Sheets(1).Active
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets("RAW").Range("A1")
For P = 2 To Sheets.Count
Sheets(P).Activate
Range("A5").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets("RAW").Range("A65536").End(xlUp)(2)
Next
Sheets("RAW").Select
MsgBox ("Here is merged data!")
End Sub
Get rid of On Error Resume Next and you'll be able to see errors in your own code, the reason you don't get a heading is because sheets(1).active is not valid code you're just copying the 1st row from raw back over itself at the moment. columns("a:k").autofit will resize the columns in your destination sheet. As for the rest of the formatting, you haven't actually shown it in your first sheet, but a straight .copy destination:=whatever as you have used should preserve cell formatting fine

Compare Cell Data and Copy

I found this great snip of code and I am trying to manipulate it to work for me, but I just can't seem to get it. Unfortunately I haven't been able to get my head around it to fully understand it, which doesn't help. So I turn to you. I need to evaluate a column of cells and look for either similarities or differences. If a cell in sheet 1 column 1 is not the same as any of the cells in sheet 2 column 1, I want to copy the entire row into sheet 1 at the bottom of the used area. I've gotten this to the point where what you see will copy the correct first cell, but I can't manipulate it to copy the entire row. I think because of how the 'With' is structured but I need to try to stay away from doing loops since there is over 30k cells to evaluate.
Going down the road I will also be wanting to look for duplicates using the same method above, and if there is a duplicate, compare the adjacent cells for differences and if there is a difference, move the existing data into a comment and move the new data into the existing cell.
Any and all advice is, as always, very appreciated.
Sub Compare_Function()
Call Get_Master_Cell_Info
Application.ScreenUpdating = False
With Sheets("Update").Range(Cells(4, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)
.Formula = "=VLOOKUP(A4,'New Master Data 6.1'!A:A,1,FALSE)"
.Value = .Value
.SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
.ClearContents
End With
Application.ScreenUpdating = True
End Sub
Quick line by line breakdown
This just takes the entire used range from cells A4 to the last used cell in columnA then offsets it by one column so B4:Bx (x is the last used row in column A)
With Sheets("Update").Range(Cells(4, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)
This puts the formula in all cells so it looks up A4,A5,A6, etc in master sheet, returns the value in the master sheet or an error if its not found. It then copies the values over so they are hardcoded in
.Formula = "=VLOOKUP(A4,'New Master Data 6.1'!A:A,1,FALSE)"
.Value = .Value
Specialcells looks for constants (all cells) and value 16 which means error cells (ie cells don't exist) offsets by -1 (so column A) and copies to new sheet column A at rows.count+1
.SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
You might also want to do this after you .clearcontents so you don't get all the error cells in column B
to fix it just change the copied range to .entirerow so
.SpecialCells(xlCellTypeConstants, 16).entirerow.Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
You will also copy the errors in column B but with this structure there is no getting around that. Can always erase them from the master sheet after.
Also note this code will overwrite any data you have stored in column B.
One more note this code depends on the sheet update being active, it won't run otherwise since your cells function inside your range needs the worksheet explicitly stated, as does your rows.count. You would be better wrapping the whole thing in 2 withs, one for the sheet and one with the range (using .cells and .rows.counmt)

How to move to next blank cell?

I have data on multiple sheets in a workbook that I want copied all to one sheet in that same workbook. When I run the macro, I would like it to start by deleting the current data in the "iPage Data Export" sheet and then replacing it with data from the other sheets.
I want the process to occur one column at a time since I may not bring over everything. Right now I am trying to learn how to do just one column.
I was able to get it to copy all of the contents of a column from one sheet, but when it moves to the next sheet, it overwrites the existing data. In the end, I only get one sheets worth of data copied.
Here are my 4 problems:
How do I make it clear the data on this sheet before running the routine?
How can I make it start each copy function at the bottom of that row (i.e. after the last cell with a value)? I have tried many of the suggestions on this and other boards without success. I will admit I am not very experienced in this.
How can I make it copy to a particular column (currently it just seems to default to A.
How can I concatenate multiple columns during the paste function? I.e. what if I want it to insert: A2&", "B2 instead of just A2
Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "iPage Data Export" Then
Sht.Select
Range("C:C").Copy
Sheets("iPage Data Export").Select
ActiveSheet.Paste
Else
End If
Next Sht
End Sub
How do I make it clear the data on this sheet before running the routine?
Sht.Cells.ClearContents
How can I make it start each copy function at the bottom of that row (i.e. after the last cell with a value)? I have tried many of the suggestions on this and other boards without success. I will admit I am not very experienced in this.
Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
In detail:
Rows.Count will return the number of rows in the sheet, so in the legacy style *.xls workbooks this would return the number 65,536. Therefore "C" & Rows.Count is the same as C65536
Range("C" & Rows.Count).End(xlUp) is the same as going to C65536 and pressing Ctrl + ↑ - The command End(xlDirection) tells the program to go the last cell in that range. In this case, we would end up at the last cell containing data in column C.
.Offset(1, 0) means that we want to return the range offset by an amount of rows and/or columns. VBA uses RC (Rows Columns) references, so whenever you see something like the Offset() function with two numbers being passed as the arguments, it usually relates to the row, and the column, in that order. In this case, we want the cell that is one row below the last cell we referenced.
All-in-all the phrase Range("C" & Rows.Count).End(xlUp).Offset(1, 0) means go to the last cell in column C, go up until we hit the last cell with data, and then return the cell below that - which will be the next empty cell.
How can I make it copy to a particular column (currently it just seems to default to A.
Range("C:C").Copy Destination:=Sheets("iPage Data Export").Range("A:A")
You can pass the Destination argument in the same line and actually bypass the clipboard (faster and cleaner)
How can I concatenate multiple columns during the paste function? I.e. what if I want it to insert: A2&", "B2 instead of just A2
Lets say you wanted to reference column A, B, and F - just use:
Range("A1, B1, F1").EntireColumn
To summarise, you could streamline your existing code to something like (untested):
Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "iPage Data Export" Then
Sht.Range("C1:C" & Cells(Sht.Rows.Count, 3).End(xlUp).Row).Copy Destination:=Sheets("iPage Data Export").Range("A:A")
End If
Next
End Sub
This should do for the copying:
Sub CombineData()
Dim sheet As Worksheet
For Each sheet In Worksheets
If (sheet.Name <> "iPage Data Export") Then
sheet.Select
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Worksheets("iPage Data Export").Activate
Cells(1, ActiveCell.SpecialCells(xlCellTypeLastCell).Column + 1).Select
ActiveSheet.Paste
End If
Next
End Sub
For the concatenation you need to be more specific - but I guess you should open a new question with a clearer focus if you need specific help on that.

Copy data from multiple excel sheets and append that to a single excel sheet using VBScript

The scenario is as follows:
I have an excel (.xls) file with data. (eg. A.xls)
The Data on this excel file are on a single worksheet (Sheet 1).
The number of columns in this file is fixed i.e. 8
However, the number of rows containing data may vary from time to time. (This file is updated by another program from time to time)
Now, I have another excel file (eg. B.xls) with similar type of data but not same as the contents of A.xls.
The number of columns in B.xls is 8 as well. However, the number of rows containing data are unknown.
I want to copy the contents of A.xls, 2nd row onwards (excluding the 1st row containing the column headers) and append/paste the same to the B.xls file, without over-writing the existing data on B.xls.
With all these details in mind, I want to write a vbscript to automate this task.
Please help.
Thanks a lot, in advance.
It needs a lot of cleanup, but something like this should work. I'll clean it up a bit and then make an edit.
Sub CopyRows()
' Choose the name of the Second Workbook and last column.
' It must be in the same directory as your First Workbook.
secondWorkbook = "B.xls"
lastColumn = "H"
' A couple more variables
currentWorkbook = ThisWorkbook.Name
Workbooks.Open ThisWorkbook.Path & "\" & secondWorkbook
' In the First Workbook, find and select the first empty
' cell in column A on the first Worksheet.
Windows(currentWorkbook).Activate
With Worksheets(1).Columns("A:A")
Set c = .Find("", LookIn:=xlValues)
If Not c Is Nothing Then
' Select and copy from A2 to the end.
secondAddress = Replace(c.Address, "$A$", "")
Range("A2:" & lastColumn & CStr(CInt(secondAddress) - 1)).Select
Selection.Copy
End If
End With
' Activate the Second Workbook
Windows(secondWorkbook).Activate
With Worksheets(1).Columns("A:A")
Set c = .Find("", LookIn:=xlValues)
If Not c Is Nothing Then
' Select and paste the data from First Workbook
Range(c.Address).Select
ActiveSheet.Paste
End If
End With
End Sub
Update: That should do the trick. I copied from the wrong workbook the first time around, too. Let me know if you have questions.
This is something the Macro Recoder could have written for you. You would come out with different approach.
Turn on recording. Open A.xls and B.xls. Move down one row on a. Press Shift+End then →, then Shift+End+↓. Then Ctrl+C to copy your data. Switch back to B. End+↓, ↓. Ctrl+V to paste. Turn off recording.
You can record in Excel.
Alt+T,M,R
then Home key then ↑. Stop recording.
Look what Excel wrote
Selection.End(xlUp).Select
or if you had of recorded Go To dialog
Application.Goto Reference:="R1C1"
or if you had of recorded Ctrl+Home
Range("A1").Select
To convert to vbscript
Record the steps in excel macro recorder. You have to rewrite it a bit because it uses a type of syntax that vbs doesn't.
This applies (I don't have a medium9) xlRangeAutoFormatAccounting4 in vba.
Selection.AutoFormat Format:=xlRangeAutoFormatAccounting4, Number:=True, _
Font:=True, Alignment:=True, Border:=True, Pattern:=True, Width:=True
So first look up constants in vba's object browser. xlRangeAutoFormatAccounting4 = 17
Then look the function up in object browser and look at the bottom for the function definition,.
Function AutoFormat([Format As XlRangeAutoFormat = xlRangeAutoFormatClassic1], [Number], [Font], [Alignment], [Border], [Pattern], [Width])
So the vba becomes in vbs (and vbs works in vba) (and as you can see you can work out the correct way without needing to look the function up usually)
Selection.AutoFormat 17, True, True, True,True, True, True
So your code becomes
objXLWs.Range("A3").CurrentRegion.Select.AutoFormat 17, True, True, True,True, True, True