Copy cells between workbooks - vba

Could someone please help me with some VBA code.
I am trying to copy 2 ranges of cells between workbooks (both workbooks should be created beforehand as i don't want the code to create a new workbook on the fly).
Firstly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell H5 to the last row in column H with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell B2 for as many cells down in the B column
Secondly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell K5 to the last row in column K with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell D2 for as many cells down in the D column
Here is what I have so far:
Sub CopyDataBetweenBooks()
Dim iRow As Long
Dim wksFr As Worksheet
Dim wksTo As Worksheet
wksFr = "C:\booka.xls"
wksTo = "C:\bookb.xls"
Set wksFrom = Workbooks(wksFr).Worksheets("Sheet 3")
Set wksTo = Workbooks(wksTo).Worksheets("Sheet 1")
With wksFrom
For iRow = 1 To 100
.Range(.Cells(iRow, 8), .Cells(iRow, 9)).Copy wksTo.Cells(iRow, 8)
Next iRow
End With
End Sub

Assuming you have the reference to wksFrom and wksTo, here is what the code should be
wksFrom.Range(wksFrom.Range("H5"), wksFrom.Range("H5").End(xlDown)).Copy wksTo.Range("B2")
wksFrom.Range(wksFrom.Range("K5"), wksFrom.Range("K5").End(xlDown)).Copy wksTo.Range("D2")

Here's an example of how to do one of the columns:
Option Explicit
Sub CopyCells()
Dim wkbkorigin As Workbook
Dim wkbkdestination As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim lastrow As Integer
Set wkbkorigin = Workbooks.Open("booka.xlsm")
Set wkbkdestination = Workbooks.Open("bookb.xlsm")
Set originsheet = wkbkorigin.Worksheets("Sheet3")
Set destsheet = wkbkdestination.Worksheets("Sheet1")
lastrow = originsheet.Range("H5").End(xlDown).Row
originsheet.Range("H5:H" & lastrow).Copy 'I corrected the ranges, as I had the src
destsheet.Range("B2:B" & (2 + lastrow)).PasteSpecial 'and destination ranges reversed
End Sub
As you have stated in the comments, this code above will not work for ranges with spaces, so substitute in the code below for the lastrow line:
lastrow = originsheet.range("H65536").End(xlUp).Row
Now ideally, you could make this into a subroutine that took in an origin workbook name, worksheet name/number, and range, as well as a destination workbook name, worksheet name/number, and range. Then you wouldn't have to repeat some of the code.

You can use special cells like Jonsca has suggested. However, I usually just loop through the cells. I find it gives me more control over what exactly I am copying. There is a very small effect on performance. However, I feel that in the office place, making sure the data is accurate and complete is the priority. I wrote a response to a question similar to this one that can be found here:
StackOverflow - Copying Cells in VBA for Beginners
There is also a small demonstration by iDevelop on how to use special cells for the same purpose. I think that it will help you. Good luck!
Update
In response to...
good start but it doesn't copy anything after the first blank cell – trunks Jun 9 '11 at 5:08
I just wanted to add that the tutorial in the link above will address the issue brought up in your comment. Instead of using the .End(xlDown) method, loop through the cells until you reach the last row, which you retrieve using .UsedRange.Rows.Count.

Related

Weird activecell.offset output

Sub Link()
Dim Turbidity As Long
Dim RawTurbidity As Range
'Sets variables Turbidity being the ActiveCell and RawTurbidity referring to the last captured cell in raw sheets'
Turbidity = ActiveCell.Row
Set RawTurbidity = Sheets("Raw Data").Range("C4").End(xlDown)
'The formula assigning the last captured cell in Raw sheets to the active cell '
Sheet1.Range(Sheet1.Cells(Turbidity, 4), Sheet1.Cells(Turbidity, 4)).Formula = RawTurbidity
End Sub
So this is the code I have and currently it does what it's suppose to do. We have two sheets atm sheet1 and Raw Data An instrument spits out data into column C of Raw data starting wtih C4 and going all the way down. The current code I wrote in essence paste the newest value the instrument spits out to the active cell in sheet1. I have a code on Raw Data that runs the macro only when a change is made to column C4 and lower. And it works exactly how I want it to however...
my question or issue is that when I add activecell.offset(1,0).select in order to have the activecell automatically go to the next row in sheet1 without me moving the mouse the macro copies and paste the same data into the next 4 cells. If I have the intrument spit out the data again than this time it occupies the next 6 rows with the same data.
Joe B, I think you are making this harder than it is.
Last value in a sheet column gets copied to the next open row in a specified column on another sheet? Is that right?
Option Explicit
Sub Link()
Dim ws1 As Worksheet
Dim wsRaw As Worksheet
Dim ws1LastRow As Long ' "Turbidity"
Dim wsRawLastRow As Long ' "RawTurbidity"
' I suggest you just name the sheets using the developer prop window
'It cuts this whole part out as you can call them directly
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
ws1LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 'lets say you are pasting to column A
'ws1LastRow = ws1LastRow + 1
'There you go the next writable cell row, this is wasted code though, see below you just increment when you need it
wsRawLastRow = wsRaw.Cells(wsRaw.Rows.Count, "C").End(xlUp).Row 'This method doesn't care if your data starts in C4
'No formula needed, it is a straight "copy" here, actually faster as its an assignment
ws1.Cells(ws1LastRow + 1, "A").Value = wsRaw.Cells(wsRawLastRow, "C").Value
'the next open cell (defined by row) in your sheet 1 column is equal to the last row of your Raw Data sheet column
End Sub
Issue is that the data in sheet one is not inputted in order. A person may need the data calculated to row 10 and the next calculation needs to be in row 20 hence the need to copy the data into the active cell.
This was my bad for not stating that in the initial post as it's the primary reason for this strange formula.

Trying to select a range of cells from one column and paste it below the last filled cell in another column

Hi there I am trying to merge two sheets. I'd need to copy a range from one column like to the next empty cell of a column on another sheet. I've tried around five methods I've found on the internet and none of them worked so far, even though it seems like it should be an easy operation. I have the following code that gives
Copy method of Range class failed
Any help would be appreciated.
Sub gMerge()
Dim ssaw As Worksheet
Dim trckr As Worksheet
Set ssaw = Sheets("SSAW_DATA")
Set trckr = Sheets("SQL_DATA_FEED")
'ssaw.Range("G2", Selection.end(xlDown)).Copy Destination:=ssaw.Range("H2")
ssaw.Range("C2", Selection.end(xlDown)).Copy Destination:=trckr.Range("B2").end(xlDown).Row + 1
End Sub
The range + 1 is throwing you.
Try defining the last row outside of the destination, so you can paste to a known cell location, such as:
dim lr as long, lr2 as Long
With Sheets("SQL_DATA_FEED")
lr = .cells(.rows.count,2).end(xlup).row
lr2 = ssaw.cells(ssaw.rows.count,3).end(xlup).row
ssaw.Range(ssaw.cells(2,"C"),ssaw.cells(lr2,"C")).Copy Destination:=.cells(lr+1,2)
End With

How to loop a dynamic range and copy select information within that range to another sheet

I have already created a VBA script that is about 160 lines long, which produces the report that you see below.
Without using cell references (because the date ranges will change each time I run this) I now need to take the users ID, name, total hours, total break, overtime 1, and overtime 2 and copy this data into sheet 2.
Any suggestions as to how I can structure a VBA script to search row B until a blank is found, when a blank is found, copy the values from column J, K, L, M on that row, and on the row above copy value C - now paste these values on sheet 2. - Continue this process until you find two consecutive blanks or the end of the data...
Even if you can suggest a different way to tackle this problem than the logic I have assumed above it would be greatly appreciated. I can share the whole code if you are interested and show you the data I began with.
Thank you in advance,
J
As discussed, here's my approach. All the details are in the code's comments so make sure you read them.
Sub GetUserNameTotals()
Dim ShTarget As Worksheet: Set ShTarget = ThisWorkbook.Sheets("Sheet1")
Dim ShPaste As Worksheet: Set ShPaste = ThisWorkbook.Sheets("Sheet2")
Dim RngTarget As Range: Set RngTarget = ShTarget.UsedRange
Dim RngTargetVisible As Range, CellRef As Range, ColRef As Range, RngNames As Range
Dim ColIDIndex As Long: ColIDIndex = Application.Match("ID", RngTarget.Rows(1), 0)
Dim LRow As Long: LRow = RngTarget.SpecialCells(xlCellTypeLastCell).Row
'Turn off AutoFilter to avoid errors.
ShTarget.AutoFilterMode = False
'Logic: Apply filter on the UserName column, selecting blanks. We then get two essential ranges.
'RngTargetVisible is the visible range of stats. ColRef is the visible first column of stats.
With RngTarget
.AutoFilter Field:=ColIDIndex, Criteria1:="=", Operator:=xlFilterValues, VisibleDropDown:=True
Set RngTargetVisible = .Range("J2:M" & LRow).SpecialCells(xlCellTypeVisible)
Set ColRef = .Range("J2:J" & LRow).SpecialCells(xlCellTypeVisible)
End With
'Logic: For each cell in the first column of stats, let's get its offset one cell above
'and 7 cells to the left. This method is not necessary. Simply assigning ColRef to Column C's
'visible cells and changing below to CellRef.Offset(-1,0) is alright. I chose this way so it's
'easier to visualize the approach. RngNames is a consolidation of the cells with ranges, which we'll
'copy first before the stats.
For Each CellRef In ColRef
If RngNames Is Nothing Then
Set RngNames = CellRef.Offset(-1, -7)
Else
Set RngNames = Union(RngNames, CellRef.Offset(-1, -7))
End If
Next CellRef
'Copy the names first, then RngTargetVisible, which are the total stats. Copying headers is up
'to you. Of course, modify as necessary.
RngNames.Copy ShPaste.Range("A1")
RngTargetVisible.Copy ShPaste.Range("B1")
End Sub
Screenshots:
Set-up:
Result:
Demo video here:
Using Filters and Visible Cells
Let us know if this helps.

vba copy values in different sheets and cells

I have a bit of an issue. I have a table with 2 rows and several columns in a tab. One row contains several words and the second row contains the location of where those values should be copied.
For example :
Row 1 Sheet1!$D$1 Sheet5!$F$1 Sheet6$F$1 Sheet3!$D$1
Row 2 apple peer orange sum
So for example, I would like to copy apple to tab : sheet 1 in cell D1.
Is this possible in vba ?
Thanks!!
I will show you one simple example on how to achieve what you want. You will have to amend the code to suit your needs.
The below code is an example for Sheet1!$D$1 and Apple. I am assuming that the values are stored in "Sheet2" in Cell A1 and A2. Also I am not doing any error handling. Hope you will take care of that as well.
Sub Sample()
Dim rng As Range
Dim Sh As String, Cl As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet2")
With ws
Sh = Split(.Range("A1").Value, "!")(0)
Cl = Split(.Range("A1").Value, "!")(1)
Set rng = ThisWorkbook.Sheets(Sh).Range(Cl)
rng.Value = .Range("A2").Value
End With
End Sub

vba excel counta

Cells(4, x) = Application.WorksheetFunction.COUNTA(Workbooks(""DB_Report.xls"").Sheets(x).Range(A:A))
I am trying to get the above function to work.
I am calling the script from the workbook DB_report.xls
This creates a new workbook ("month") and starts filling in the values.
What I am trying to get to is where
cell 4,1 in months has the counta of sheet 1 from DB_report
cell 4,2 in months has the counta of sheet 2 from DB_report
Can anyone reword the line above so when "months is the active work sheet I can call counta from DB_Report
The line before this is
NameSH = Workbooks("DB_Report.xls").Sheets(x).Name and this works fine and returns the name of work sheet x
Thanks
Aaron
Ok for a bit further explicanation
the steps I want to do go some thing like this
select workbook months.xls
select sheet(1)
cell (x,y) = counta( of range A:A , in worksheet("DB_Report") of worksheet (DB_report.xls)
Now I know
Cells(4, x) = Application.WorksheetFunction.COUNTA(sheet(3).range(a:A)
will work with in the active work sheet. So if the active sheet is sheet 1 then that would count up he numbe of cells in sheet 3 of the same workbook. I wanted to know if as well as refrenced sheet and cells in the function I can also refrence a workbook by name.
of course i could swqap to book "DB_Report" save the value to a varible and then swap back to book "Month" and copy it to the cell.
or could I do workbook("month").sheet(y).cells(a,b) = Application.WorksheetFunction.COUNTA(sheet(3).range(a:A)
while in workbook "month"
so really what i need is how do you refrence workbook,sheet and cells all with in a function?
I don't think this is exactly what you were trying to do, but it comes close and is a bit more generalized. It counts up the worksheets in what would be DB_Report.xls and uses that to specify that number of cells in months.xls
If you are running the macro from the DB_Report.xls you don't need to specify anything about that workbook or sheets.
Sub counts()
Dim sheetcounts As Integer
Dim countas() As Integer
Dim index As Integer
Dim wksht As Worksheet
Dim newbook As Workbook
sheetcounts = ActiveWorkbook.Sheets.Count
ReDim countas(sheetcounts)
For Each wksht In ActiveWorkbook.Sheets
countas(index) = Application.WorksheetFunction.CountA(wksht.Range("A:A"))
index = index + 1
Next
Set newbook = Workbooks.Add
newbook.Activate
newbook.ActiveSheet.Range(Cells(4, 1), Cells(4, sheetcounts)) = countas
newbook.SaveAs ("months.xls")
End Sub
It will require any error checking or verification that you need to put into it.
Hi Cheers for the comments, but i finaly worked out what the problem was.
it was simple really I was just missing some formatting
the line below works correctly
cell(x,y) = Application.WorksheetFunction.CountA(Workbooks("DB_Report.xls").Sheets(x).Range("A:A"))