I want to copy values from one excel file to another excel file, but on later stages of my project, I may need to cross check the value and then paste it in the new excel file. So I dont want to copy whole sheet at a time. I want to copy a value by value.
I was able to open and switch between to excel file but I m not able to copy and paste the values.
Following is the code I tried-
Private Sub CommandButton1_Click()
Dim x As Long
Dim NumRows As Long
Set fromwb = Workbooks.Open("G:\Excel\From.xlsx")
Set towb = Workbooks.Open("G:\Excel\To.xlsx")
fromwb.Activate
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
ReDim a(1 To NumRows)
For x = 1 To NumRows
fromwb.Activate
a(x) = Cells(x, 1).Value
towb.Activate
Cells(x, 1).Value = a(x)
Next x
End Sub
Thanking you in anticipation.
Try out the code below. I hope the comments are very clear!
Option Explicit
Private Sub CommandButton1_Click()
Dim SourceBook As Workbook, DestBook As Workbook
Dim SourceSheet As Worksheet, DestSheet As Worksheet
Dim Index As Long, NumRows As Long
Dim ValidCheck As Boolean
'set references up-front
Set SourceBook = Workbooks.Open("G:\Excel\From.xlsx")
Set SourceSheet = SourceBook.ActiveSheet
With SourceSheet
NumRows = .Range("A", .Rows.Count).End(xlUp).Row '<~ last row in col A
End With
Set DestBook = Workbooks.Open("G:\Excel\To.xlsx")
Set DestSheet = DestBook.ActiveSheet
'loop through col A and write out values to destination
For Index = 1 To NumRows
'...
'do your value validation
'in this space using ValidCheck
'...
If ValidCheck Then '<~ if true write to Dest
DestSheet.Cells(Index, 1) = SourceSheet.Cells(Index, 1)
End If '<~ if not, do not write to Dest
Next Index
End Sub
You just need to specify the to cells as equal to the from cells, no need to loop anything.
Workbooks("To.xlsx").Sheets("ToSheetNameHere").Range("rangehere").Value = Workbooks("From.xlsx").Sheets("FromSheetNameHere").Range("rangehere").Value
Keep in mind if you have macro code in the workbook(s) they will be .xlsm and not .xlsx
Related
I have about 50 Excel sheets in one folder, on my MacBook - (/Users/myusername/Desktop/Tidy/folder")
I want to perform the following Macro on them all:
Sub SmartCopy()
Dim s1 As Worksheet, s2 As Worksheet
Dim N As Long, i As Long, j As Long
Set s1 = Sheets("s1")
Set s2 = Sheets("s2")
N = s1.Cells(Rows.Count, "Y").End(xlUp).Row
j = 1
For i = 1 To N
If s1.Cells(i, "Y").Value = "No" Then
Else
s1.Cells(i, "Y").EntireRow.Copy s2.Cells(j, 1)
j = j + 1
End If
Next i
End Sub
I am struggling to get the sheets to open, almost like the filepath won't be recognised, also each sheet is named like this:
business-listing-002-w-site.csv
with one tab:
business-listing-002-w-site.csv
So I also need to either 1) rename the sheet each time 2) have the macro just open the only sheet in the workbook.
I want to copy all data from all workbooks into one master. I did try to add my Macro and adapt this one but just can't get it to run at all.
link to another post
You need to define the workbook (file), not just the sheet(tab).
Dim filePath as String
Dim sheetStart as String
Dim count as Integer
Dim sheetEnd as string
Dim thisSheet as Worksheet
Dim wb1 as Workbook
Dim ws1 as Worksheet
filePath = "/Users/myusername/Desktop/Tidy/folder/"
sheetStart = "business-listing-"
sheetEnd = "-w-site"
Set thisSheet as ThisWorkbook.Worksheets("Sheet1")
For count = 1 to 44 'the range of sheets you have
Set wb1 = Workbooks.Open(filePath & sheetStart & format(count, "000") & sheetEnd & ".csv")
Set ws1 = wb1.Worksheets(sheetStart & format(count, "000") & sheetEnd)
'move the ranges you want from ws1 to thisSheet
wb1.close
next count
each time the code loops, it will change the filename being opened and the sheet that it is looking for.
I assume you either know or can find how to copy a range from ws1 to the next available row of thisSheet based on the original code you provided.
edited with improved code based on comments
I have a range of data on Sheet2 that links it to Sheet1 (Sheet1 is formatted and linked by Sheet2 using =if(Sheet2$x$x="","",Sheet2$x$x); this way any data put into the range C13:G62 of Sheet2 shows up in Sheet1 range C13:G62. The beginning portion on the code works to move JUST the data in the specified range to the BATCH file Sheet3 and finds the last row pasting the values from Sheet1 without copying the formulas. It was made this way so I can delete data on Sheet2 to wipe Sheet1 clean but still have all the backup data on one Sheet3.
Anyway, the problem lies when I tried to manipulate the code to copy all contents on Sheet1 (to DUPLICATE SHEET1) to another sheet at the end of the workbook:
Sheets(Sheet1).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = _
InputBox("Name of the New WorkSheet")
This allowed me to name the sheet which was great. However by creating multiple variations of code it will not move the DATA in the RANGE to the newly created Sheet4 (there is no data). In one iteration of code I was able to get Sheet1 to copy and make Sheet4 at the end of the work book with no data in the range but have the cursor land in cell C13, the starting point for pasting just the values, and when I left click the mouse in that cell to "paste values" it would paste the values that I was trying to paste. However, either way I rearranged the code, the data would always be copied but would never paste to the Sheet4 range.
Here I have posted one variation of the code IN WHICH IT STILL WILL NOT PASTE THE VALUES TO SHEET4 (THE NEWLY CREATED SHEET) but still copies to the BATCH FILE. What am I missing here?
Dim s1Sheet As Worksheet
Dim s2Sheet As Worksheet
Dim source As String
Dim target As String
Dim rngSource As Range
Dim rngTargetStart As Range
source = "Invoice"
target = "TOTAL_INVOICE"
Application.EnableCancelKey = xlDisabled
Set s1Sheet = Sheets(source)
Set s2Sheet = Sheets(target)
Set rngSource = s1Sheet.Range("C13:G62")
Set rngTargetStart = s2Sheet.Range("C" & Rows.Count).End(xlUp).Offset(1)
'Set rngTargetFinish = ws1.Range("C" & Rows.Count).End(xlUp).Offset(1)
rngTargetStart.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
'rngTargetFinish.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
'Set target = Sheets("Sheet4").Range("B13:G63")
copy_non_formulas source:=rngSource, target:=rngTargetStart
' copy_non_formulas source:=Range("B13:G63"), target:=Range("B70:G109") Unhighlight
' copy_non_formulas source:=Range("B13:G63"), target:=Range("B13:G63") Unhighlight
'===Copies Sheet to End of WorkBook & Pastes Values======
Sheets(source).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = _
InputBox("Name of the New WorkSheet")
Range("C13:G62").ClearContents
Dim rng As Range
Set rng = ActiveSheet.Range("C13:G62")
rng.ClearContents
Dim s3Sheet As Worksheet
Dim rngTargetStart2 As Range
Set s3Sheet = Sheets(Sheets.Count)
Set rngTargetStart2 = s3Sheet.Range("C" & Rows.Count).End(xlUp).Offset(1)
rngTargetStart2.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
copy_non_formulas2 source:=rngSource, target2:=rngTargetStart2
copy_non_formulas2 source:=Range("C13:G62"), target2:=Range("C13:G62")
This is an Integrated Public Sub
copy_non_formulas(source As Range, target As Range)
Dim i As Long
Dim j As Long
Dim c As Range
For i = 1 To source.Rows.Count
For j = 1 To source.Columns.Count
Set c = source(RowIndex:=i, ColumnIndex:=j)
If Left(c.Formula, 1) <> "=" Then
target(RowIndex:=i, ColumnIndex:=j).Value = c.Value
End If
Next j
Next i
And another Public Sub for the Second Move
copy_non_formulas2(source As Range, target2 As Range)
Dim x As Long
Dim y As Long
Dim d As Range
For x = 1 To source.Rows.Count
For y = 1 To source.Columns.Count
Set d = source(RowIndex:=x, ColumnIndex:=y)
If Left(d.Formula, 1) <> "=" Then
target2(RowIndex:=x, ColumnIndex:=y).Value = d.Value
End If
Next y
Next x
I am having a problem to consolidate data from multiple worksheet into a summary worksheet. It is able to copy all the data except when the data is pasted it will overwrite the previous data. Example data in sheet A is pasted to recompile sheet starting from range A2. The problem is data in sheet B,C,D etc will also be pasted starting from range A2 causing it to overwrite each other.
This is my code.
Private Sub CommandButton2_Click()
Dim Sheetname, myrange As String
Dim A, noOfrows As Integer
Dim startRow As Integer
For i = 2 To Worksheets("Master Sheet").Cells.SpecialCells(xlCellTypeLastCell).Row
Sheetname = Worksheets("Master Sheet").Cells(i, 27).Value'All the sheets that suppose to transfer to recompile sheet
noOfrows = Worksheets(Sheetname).Cells.SpecialCells(xlCellTypeLastCell).Row
myrange = "A2:N" & CStr(noOfrows)
Worksheets(Sheetname).Select
Worksheets(Sheetname).Range(myrange).Select
Selection.Copy
Sheets("Recompile").Select
Range("A2").Select
ActiveSheet.Paste
Next i
End Sub
You need to find the UsedRange in the "Recompile" sheet and paste into the range below that:
Something like:
Private Sub CopyData()
Dim A As Long
Dim noOfrows As Long
Dim startRow As Long
Dim i As Long
Dim control As Worksheet
Dim source As Worksheet
Dim target As Worksheet
Set control = Worksheets("Master Sheet")
Set target = Worksheets.Add
For i = 2 To control.UsedRange.Rows.Count
' the target worksheet for this row of data
Set source = Worksheets(control.Cells(i, 1).Value) ' My example has this data in column A
' the address of a range with (number of rows - 1) for columns A:N
source.Range("A2:N" & source.UsedRange.Rows.Count).Copy
target.Range("A" & target.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row).PasteSpecial xlPasteValues
Next i
End Sub
Lots of information and tips here: http://www.rondebruin.nl/win/s3/win002.htm
I am attempting to first, find the the largest value in a column (C), then copy and paste that value into the next empty cell in 'Row 3' in a different (master) workbook. The macro I am running is found in the master workbook. I found this code that i believe will get the pasted cell into the correct spot, but I could use assistance in the code for how to find the largest cell in column C in the data workbook, and then copying and pasting that value.
Private Sub CommandButton1_Click()
Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextColumn As Long, LastRow As Long
Set wsMaster = ThisWorkbook.Sheets("Contract Metrics")
NextColumn = wsMaster.Range("C", 3).End(xlUp).Column + 1
Set wbDATA = Workbooks.Open("C:\Documents and Settings\Michael Palkovitz\My Documents\Test\Contracts Metrics.xlsx")
wbDATA.Close False
End Sub
Try this. First sort the column you need the value from, then get the last row and place the value into your first empty column in row 3 of your master sheet.
' Create an excel application and open the workbook containing the data
Dim app As Object
Dim wb As Object
Dim ws As Object
Set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Open("C:\Workbook1")
Set ws = wb.Sheets(1)
' Get last row with a value to use for the sort range
Dim last As Long
Dim value As Long
With ws
last = ws.Cells(ws.Rows.Count, 3).End(xlUp).row
.Range("C1:C" & last).Sort Key1:=.Range("C2"), order1:=xlAscending, Orientation:=xlTopToBottom
value = .Cells(last, 3)
End With
' Get the last filled cell and move over one to get the empty column
Dim col As Long
col = ActiveSheet.Cells(3, 1).End(xlToRight).Offset(0, 1).Column
ActiveSheet.Cells(3, col).value = value
wb.Close False
Set ws = Nothing
Set wb = Nothing
Set app = Nothing
I'm just beginning to dive into VBA and I've hit a bit of a roadblock.
I have a sheet with 50+ columns, 900+ rows of data. I need to reformat about 10 of those columns and stick them in a new workbook.
How do I programmatically select every non-blank cell in a column of book1, run it through some functions, and drop the results in book2?
I know I'm am very late on this, but here some usefull samples:
'select the used cells in column 3 of worksheet wks
wks.columns(3).SpecialCells(xlCellTypeConstants).Select
or
'change all formulas in col 3 to values
with sheet1.columns(3).SpecialCells(xlCellTypeFormulas)
.value = .value
end with
To find the last used row in column, never rely on LastCell, which is unreliable (it is not reset after deleting data). Instead, I use someting like
lngLast = cells(rows.count,3).end(xlUp).row
The following VBA code should get you started. It will copy all of the data in the original workbook to a new workbook, but it will have added 1 to each value, and all blank cells will have been ignored.
Option Explicit
Public Sub exportDataToNewBook()
Dim rowIndex As Integer
Dim colIndex As Integer
Dim dataRange As Range
Dim thisBook As Workbook
Dim newBook As Workbook
Dim newRow As Integer
Dim temp
'// set your data range here
Set dataRange = Sheet1.Range("A1:B100")
'// create a new workbook
Set newBook = Excel.Workbooks.Add
'// loop through the data in book1, one column at a time
For colIndex = 1 To dataRange.Columns.Count
newRow = 0
For rowIndex = 1 To dataRange.Rows.Count
With dataRange.Cells(rowIndex, colIndex)
'// ignore empty cells
If .value <> "" Then
newRow = newRow + 1
temp = doSomethingWith(.value)
newBook.ActiveSheet.Cells(newRow, colIndex).value = temp
End If
End With
Next rowIndex
Next colIndex
End Sub
Private Function doSomethingWith(aValue)
'// This is where you would compute a different value
'// for use in the new workbook
'// In this example, I simply add one to it.
aValue = aValue + 1
doSomethingWith = aValue
End Function
If you are looking for the last row of a column, use:
Sub SelectFirstColumn()
SelectEntireColumn (1)
End Sub
Sub SelectSecondColumn()
SelectEntireColumn (2)
End Sub
Sub SelectEntireColumn(columnNumber)
Dim LastRow
Sheets("sheet1").Select
LastRow = ActiveSheet.Columns(columnNumber).SpecialCells(xlLastCell).Row
ActiveSheet.Range(Cells(1, columnNumber), Cells(LastRow, columnNumber)).Select
End Sub
Other commands you will need to get familiar with are copy and paste commands:
Sub CopyOneToTwo()
SelectEntireColumn (1)
Selection.Copy
Sheets("sheet1").Select
ActiveSheet.Range("B1").PasteSpecial Paste:=xlPasteValues
End Sub
Finally, you can reference worksheets in other workbooks by using the following syntax:
Dim book2
Set book2 = Workbooks.Open("C:\book2.xls")
book2.Worksheets("sheet1")
For me the best way to proceed was to:
Create a new Excel Table
AutoFilter it by the parameter Criterial:="<>"
An example of the code would be:
Sub ExampleFilterCol()
' Create a Table
Dim ws As Worksheet
Dim rg As Range
Set ws = ActiveSheet
Set rg = ws.Range("A1").CurrentRegion
ws.ListObjects.Add(xlSrcRange, rg, , xlYes).Name = "myNonRepeatedTableName"
' Filter the created table
Dim Io As ListObject
Dim iCol As Long
' Set reference to the first Table on the sheet
' That should be the recently created one
Set lo = Sheets("Totalinfo").ListObjects(1)
' Set filter field
iCol = lo.ListColumns("yourColumnNameToFilter").Index
' Non-blank cells – use NOT operator <>
lo.Range.AutoFilter Field:=iCol, Criteria1:="<>"
End Sub
This might be completely off base, but can't you just copy the whole column into a new spreadsheet and then sort the column? I'm assuming that you don't need to maintain the order integrity.