I have workbook (WB1) with a Sheet (Sheet1) with data (A2:W2).
I want to create a VBA where i can copy a specific row from WB1 and paste it into antoher workbook (WB2 / Sheet2) after the last row.
Can anyone help on that?
Unfortunately I just need a code on that and my tries were not going anywhere
If both workbook are open you can do it like this.
Sub CopyRow()
On Error GoTo Err
With Workbooks("Book1").Worksheets("Sheet1") ' like From ThisWorkbook
myrow = 4 ' Row to be copied
colCount = .UsedRange.Columns.Count ' Colums to be copied like From ThisWorkbook
DesRow = "A" & Trim(CStr(Workbooks("Book2").Worksheets("Sheet1-(inBok2)").UsedRange.Rows.Count + 1))
.Range(.Cells(myrow, 1), .Cells(myrow, colCount)).Copy Destination:=Workbooks("Book2").Worksheets("Sheet1-(inBok2)").Range(DesRow)
End With
Exit Sub
Err:
MsgBox ("# Error - Can`t perform the copy. Check sheet names and that bouth workbooks are open.")
End Sub
Related
I need to copy the worksheets name into Row 1 of another worksheet of the same file. Here is what I have/need:
File has different worksheets, but I need only the title from the sheet 3 on
The worksheet where I want to copy the names is sheet 2
the names need to be copy on row 1, from cell B1
I'll run this macro periodically, so I'd need new sheet names to be added every time while keeping there the one already copied.
Can you help me? :)
List Worksheet Names in a Row
Sub ListNames()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim dCell As Range: Set dCell = wb.Worksheets(2).Range("B1")
Dim n As Long
For n = 3 To wb.Worksheets.Count
dCell.Value = wb.Worksheets(n).Name
Set dCell = dCell.Offset(, 1)
Next n
End Sub
From what you write it's really hard to tell what you actually need.
The following VBA code writes the name of the 3rd worksheet to the B1 cell of sheet 2. If you don't have 3 sheet's nothing happens:
Sub WriteTheNameOfWorksheet3IntoWorksheet2CellB1()
If ActiveWorkbook.Worksheets.Count >= 3 Then
ActiveWorkbook.Worksheets(2).Range("B1") = ActiveWorkbook.Worksheets(3).Name
End If
End Sub
I'm having trouble copying rows from multiple sheets to a new worksheet. The code I now have is as following:
Sub Samenvoegen()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Index"
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("2:2").Select
Range(Selection, Cells(Rows.Count, "2:2").End(xlUp)).Copy Range("2:2") ' select all cells in this sheets
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
For example: I have 10 worksheets in my excel file and if I use this macro, it merges row 2 from all those excel worksheets into 1 worksheet named "Index" and pastes per worksheet under each other. Thats what I want. But the problem with this macro is that it copies the second row from the first worksheet correct. But after that first worksheet it copies from B2 from the second worksheet and C2 from the third worksheet and so on..
I would like to have a macro which copies all of the second row from the worksheets and pastes it into the new worksheet under each other. What am I doing wrong here?
Sub Samenvoegen()
Dim ws As Worksheet, wb As Workbook, i As Long
Set wb = ThisWorkbook
wb.Sheets.Add ' add a sheet in first place
wb.Sheets(1).Name = "Index"
' work through sheets
i = 1
For Each ws In wb.Sheets ' from sheet 2 to last sheet
If ws.Name <> "Index" Then
' copy row(2) into the new sheet
ws.Rows(2).Copy
wb.Sheets("Index").Range("A" & i).PasteSpecial xlPasteValues
i = i + 1
End If
Next
End Sub
To all,
thanks for your time in advance.
we already have working code to move data from one wrksht to another with vb in excel.
we use:
Set lastrow = Sheets ("SR log").Cells(Rows.Count, 1).End(x1UP)
With LastRow
This places our selected data on the last open row of sheet 2
Is it possible to , instead of the last row, Search for a reference number from the first sheet that is already on the second sheet , lets say Cell G3. use the information from the first sheet in cell g3 and look for it on the second sheet.
Once that row is found ( the G3 data from the first sheet will be in column A of the second sheet)
Now apply data to that row where applicable.
any help would be appreciated.
2/22/19
Here is my response.
thankyou for taking the time
I have put something together but wanted to run it by before executing
[code]
Private Sub CommandButton2_Click()
Workbooks.Open Filename:="G:\General\COVER SHEET_Protective\Protective Packaging Order Log.xlsm", Password:="PP", WriteResPassword:="PP"
Dim FoundRow As Variant
FoundRow = Application.Match(Sheets(1).Range("G3"), Sheets(2).Columns(1), 0)
If IsNumeric(FoundRow) Then
With FoundRow
' found, use FoundRow like LastRow before
End With
Else
' not found :(
End If
.Offset(1).Font.Size = 14
.Offset(1, 9) = ws.[I10]
.Offset(1, 10) = ws.[I11]
End Sub
[/code]
I'm am a little unsure about this row
[code]
Application.Match(Sheets(1).Range("G3"), Sheets(2).Columns(1), 0)
[/code]
the match sheets 1 on the first workbook is called worksheet
and on the second workbook where the search is happening on the first
column
the sheet is called orderlog
thanks
You can find the matching row with Application.Match:
Private Sub CommandButton2_Click()
Dim wb1 As Workbook ' first workbook
Dim wb2 As Workbook ' second workbook
Dim wsCheck As Worksheet ' sheet in the first workbook
Dim wsOrderlog As Worksheet ' sheet in the second workbook
' address the first workbook and its sheet
' if this VBA-code is in the frist workbook, it's "ThisWorkbook"
Set wb1 = ThisWorkbook
Set wsCheck = wb1.Worksheets("Worksheet")
' check, if second workbook is already open
For Each wb2 In Workbooks
If wb2.Name = "Protective Packaging Order Log.xlsm" Then Exit For
Next wb2
' if not already open, then open it, and address its sheet also
If wb2 Is Nothing Then
Set wb2 = Workbooks.Open( _
Filename:="G:\General\COVERSHEET_Protective\Protective Packaging Order Log.xlsm", _
Password:="PP", _
WriteResPassword:="PP")
End If
Set wsOrderlog = wb2.Worksheets("orderlog")
' search a value from the first workbook's sheet within second workbook's sheet
Dim FoundRow As Variant
FoundRow = Application.Match(wsCheck.Range("G3").Value, wsOrderlog.Range("A:A"), 0)
If IsNumeric(FoundRow) Then ' if found
' please adapt to your needs:
wsOrderlog.Cells(FoundRow, 1).Font.Size = 14
wsOrderlog.Cells(FoundRow, 9).Value = wsCheck.Range("I10").Value
wsOrderlog.Cells(FoundRow, 10).Value = wsCheck.Range("I11").Value
Else
MsgBox "Sorry, the value in cell G3" & vbLf & _
wsCheck.Range("G3").Value & vbLf & _
"could not be found in orderlog column A."
End If
' close the second workbook (Excel will ask, if to save)
wb2.Close
End Sub
I would really appreciate it if someone can help me with a VBA. Loop through multiple worksheet in same WorkBook and copy 1 column i.e. col B, and paste/append in the next blank column in the active worksheet.
Thanks,
Adil
There are some limitations here but this should get you started.
Sub copyColumn()
Dim wks As Worksheet
Set wks = ActiveSheet
'Source worksheet to copy from
Dim srcwk As Worksheet
Set scrwk = ActiveWorkbook.Worksheets(3)
'Copy range A1:A10 from source to active sheet in next open column
scrwk.Range("A1:A10").Copy wks.Range("IV1").End(xlToLeft).Offset(0, 1)
End Sub
Something like this?
Sub Move_Column()
CurrWS = ActiveSheet.Name
For each Sheet in ActiveWorkbook.Sheets
If Sheet.Name <> CurrWS Then
NextColumn = Sheets(CurrWS).Range("XFD1").End(xlToLeft).Column + 1
Sheets(CurrWS).Range(Sheets(CurrWS).Cells(1, NextColumn), Sheets(CurrWS).Cells(100, NextColumn)).Value = Sheet.Range(Sheet.Cells(1, 2), Sheet.Cells(100, 2)).Value
End if
Next
End Sub
Unfortunately for my employer, none of my network engineering courses included advanced Excel formula programming. Needless to say, I know nothing about Excel save for basic SUM and COUNT formula commands.
My employer has an Excel workbook with multiple worksheets within it representing each month of the calendar year. We want to be able to have a "total" worksheet in the workbook that reflects all data across the entire workbook in each column/row.
An example for the sake of clarity:
In the worksheet "May_2013", column A is labeled "DATE". Cell A2 contains the data "MAY-1".
In the worksheet "June_2013", column A is labeled "DATE". Cell A2 contains the data "JUNE-1".
In the worksheet "Total", column A is labeled "DATE". We want cells A2 to reflect "MAY-1" and A3 to reflect "JUNE-1".
We want to do this for all worksheets, columns A-Q, rows 2-33 and populate a master sheet at the very end containing all data in all worksheets in their corresponding columns.
Is this possible?
Here are two VBA solutions. The first does this:
Check if a sheet "totals" exists. Create it if it does not
Copy the first row (A to Q) of first sheet to "totals"
Copy block A2:Q33 to "totals" sheet starting at row 2
Repeat for all other sheets, appending 32 rows lower each time
The second shows how to do some manipulation of the column data before copying: for each column it applies the WorksheetFunction.Sum(), but you could replace that with any other aggregating function that you would like to use. It then copies the result (one row per sheet) to the "totals" sheet.
Both solutions are in the workbook you can download from this site. Run the macros with , and pick the appropriate one from the list of options that shows up. You can edit the code by invoking the VBA editor with .
Sub aggregateRaw()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range
sheetCount = ActiveWorkbook.Sheets.Count
' add a new sheet at the end:
If Not worksheetExists("totals") Then
Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
newSheet.Name = "totals"
Else
Set newSheet = ActiveWorkbook.Sheets("totals")
End If
Set targetRange = newSheet.[A1]
' if you want to clear the sheet before copying data, uncomment this line:
' newSheet.UsedRange.Delete
' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
ActiveWorkbook.Sheets(1).Range("1:1").Copy targetRange
Set targetRange = targetRange.Offset(1, 0) ' down a row
' copy blocks of data from A2 to Q33 into the "totals" sheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> newSheet.Name Then
ws.Range("A2", "Q33").Copy targetRange
Set targetRange = targetRange.Offset(32, 0) ' down 32 rows
End If
Next ws
End Sub
Sub aggregateTotal()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range
Dim columnToSum As Range
sheetCount = ActiveWorkbook.Sheets.Count
' add a new sheet at the end:
If Not worksheetExists("totals") Then
Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
newSheet.Name = "totals"
Else
Set newSheet = Sheets("totals")
End If
' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
Set targetRange = newSheet.[A1]
ActiveWorkbook.Sheets(1).Range("A1:Q1").Copy targetRange
Set targetRange = targetRange.Offset(1, 0) ' down a row
For Each ws In ActiveWorkbook.Worksheets
' don't copy data from "total" sheet to "total" sheet...
If ws.Name <> newSheet.Name Then
' copy the month label
ws.[A2].Copy targetRange
' get the sum of the coluns:
Set columnToSum = ws.[B2:B33]
For colNum = 2 To 17 ' B to Q
targetRange.Offset(0, colNum - 1).Value = WorksheetFunction.Sum(columnToSum.Offset(0, colNum - 2))
Next colNum
Set targetRange = targetRange.Offset(1, 0) ' next row in output
End If
Next ws
End Sub
Function worksheetExists(wsName)
' adapted from http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html
worksheetExists = False
On Error Resume Next
worksheetExists = (Sheets(wsName).Name <> "")
On Error GoTo 0
End Function
Final(?) edit:
If you want this script to run automatically every time someone makes a change to the workbook, you can capture the SheetChange event by adding code to the workbook. You do this as follows:
open the Visual Basic editor ()
In the project explorer (left hand side of the screen), expand the VBAProject
Right-click on "ThisWorkbook", and select "View Code"
In the window that opens, copy/paste the following lines of code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' handle errors gracefully:
On Error GoTo errorHandler
' turn off screen updating - no annoying "flashing"
Application.ScreenUpdating = False
' don't respond to events while we are updating:
Application.EnableEvents = False
' run the same sub as before:
aggregateRaw
' turn screen updating on again:
Application.ScreenUpdating = True
' turn event handling on again:
Application.EnableEvents = True
Exit Sub ' if we encountered no errors, we are now done.
errorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
' you could add other code here... for example by uncommenting the next two lines
' MsgBox "Something is wrong ... " & Err.Description
' Err.Clear
End Sub
Kindly use RDBMerge add-in which will combine the data from different worksheet and create a master sheet for you. Please see the below link for more details.
http://duggisjobstechnicalstuff.blogspot.in/2013/03/how-to-merge-all-excel-worksheets-with.html
Download RDBMerge
You can use the indirect function to reference the sheet name. In the image below this function takes the header name (B37) and uses it as the sheet reference. All you have to do is choose the correct "total cell" which I made "A1" in "MAY_2013". I put an image below to show you my reference name as well as tab name