I want to simply copy the first row "test" into all following sheets (Sheetxx1, Sheetx23, Sheet231, etc. ) ... (like 100 following sheets with different names).
So I tried this by recording a macro (with relative reference) and then went on the sheet, where I want to have it pasted (like Sheetx231) and then did run the macro. But what it did is it pasted again row "test" into Sheetxx23.
How can I make the macro paste the row test of Sheetxx1 into the recent sheet (I am in and run the macro)?
Sub Macro1()
Rows("1:1").Select
Selection.Copy
Sheets("Sheetxx23").Select
ActiveCell.Rows("1:1").EntireRow.Select
ActiveSheet.Paste
End Sub
You need to loop throuh all worksheets and copy/paste for each worksheet.
Option Explicit
Public Sub CopyFirstRowIntoAllWorksheets()
Dim SourceWs As Worksheet
Set SourceWs = ActiveSheet
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 'loop throuh all sheets
If Not ws.Name = SourceWs.Name Then 'makes sure source and destination is not the same sheet
SourceWs.Rows(1).Copy Destination:=ws.Rows(1) 'copy first row
End If
Next ws
Application.CutCopyMode = False
End Sub
You might benefit from reading
How to avoid using Select in Excel VBA.
Edit according comment:
If you need only the worksheets right of the active worksheet to be pasted, replace
If Not ws.Name = SourceWs.Name Then
with
If ws.Index > SourceWs.Index Then
Related
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
I wanted to create a sheet and rename it from referencing a cell in another sheet. This worked so far.
However, I'd like to copy and paste everything as values but maintaining the format from the old sheet to this newly created sheet. I don't know how to reference this just newly renamed sheet.
Code as follows:
Private Sub CreateSheet()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:=Worksheets("OldSheet"))
'the new sheet has the name from B3 of the old sheet.
ws.Name = Sheets("OldSheet").Range("B3")
'this copy paste part doesn't work, it gives an error.
Sheets("OldSheet").Copy
Sheets("ws").PasteSpecial Paste:=xlPasteValues
End Sub
Here is a simple way to do it. Create a copy of the existing sheet and then use UsedRange.Value = UsedRange.Value
With ThisWorkbook
.Sheets("OldSheet").Copy After:=.Sheets(.Sheets.Count)
With .Sheets(.Sheets.Count)
.Name = ThisWorkbook.Sheets("OldSheet").Range("B3").Value
.UsedRange.Value = .UsedRange.Value
End With
End With
You can use the below code to copy the data from one sheet to another. Found few issues with the code you were using.
You have to make the new sheet visible. (optional though).
Select the range you want to copy from old to new sheet. (Below code will copy range A1:C5 and paste it from A1 range of new sheet.
Private Sub CreateSheet()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
Worksheets("OldSheet"))
'the new sheet has the name from B3 of the old sheet.
ws.Name = Sheets("OldSheet").Range("B3")
ws.Visible = xlSheetVisible
'this copy paste part doesn't work, it gives an error.
ThisWorkbook.Sheets("OldSheet").Range("A1:C5").Copy
ThisWorkbook.Sheets(ws.Name).Range("A1").PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Sheets(ws.Name).Range("A1").PasteSpecial Paste:=xlPasteFormats
End Sub
Update:
As suggested in comments you can use UsedRange to copy.
You can replace below line of code in original code above.
uRange = ThisWorkbook.Sheets("OldSheet").UsedRange.Address
ThisWorkbook.Sheets("OldSheet").Range(uRange).Copy
ThisWorkbook.Sheets(ws.Name).Range("A1").PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Sheets(ws.Name).Range("A1").PasteSpecial Paste:=xlPasteFormats
I copy a worksheet "Costing Sheet" to a new worksheet.
I use this code:
Sub CopyPasteSheetAsValues()
Worksheets("Costing Sheet").Copy After:=Worksheets("Costing Sheet")
Application.CutCopyMode = False
End Sub
There are formulas in the copied sheet that I do not need in the new worksheet. I would like to copy the worksheet into a new sheet but paste as 'values only'.
I also have the code below that can copy and paste the worksheet but it overrides the current sheet. Instead of a new worksheet with values only, it's the same worksheet as values.
Sub CopyPasteSheet()
'Copy and Paste Summary Sheet as Values
Sheets("Costing Sheet").Cells.Copy Before:=Sheets("Comparison Job")
Sheets("Costing Sheet").Cells.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
I tried to combine the codes but was unsuccessful.
You can exploit the fact that a sheet becomes the active one when it is copied from another sheet
Sub CopyPasteSheetAsValues()
Worksheets("Costing Sheet").Copy After:=Worksheets("Costing Sheet")
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
End Sub
Doing a copy with no destination will create a new workbook with the copied worksheet. Assigning the value of the range to the value of the range will get rid of the formulas.
Dim myNewWB as Workbook
Worksheets("Costing Sheet").Copy
Set myNewWB = ActiveWorkbook
With myNewWB.Worksheets(1)
.Range(.Cells(1,1),.Cells(.UsedRange.Rows.Count,.UsedRange.Columns.Count)).Value= _
.Range(.Cells(1,1),.Cells(.UsedRange.Rows.Count,.UsedRange.Columns.Count)).Value
End With
I have a workbook that consists of 180 worksheets. Each worksheet has the top 9 rows and columns A1:Z1 with information that I do not need.
The rest of the worksheet has data that I do need and want to append into one worksheet. The problem is that each of the worksheet has drop-down choices embedded in them. The choices have already been made and I need to append the sheets with the choices selected.
Been trying to run a VBA script but have been unsuccessful. Any help is greatly appreciated.
Thank you
Current code that I used to remove the top rows for few of the sheets, only removal but not appending. And I have inserted sheet names, but with 180 sheets that will not be possible.
Sub remove_rows()
'
' remove_rows Macro
'
'
`Rows("1:10").Select`
`Selection.EntireRow.Hidden = False`
`Range("D20").Select`
`Rows("1:9").Select`
`Range("A9").Activate`
`Selection.Delete Shift:=xlUp`
`Sheets("BioME-Box- (2)").Select`
`Rows("1:15").Select`
`Selection.EntireRow.Hidden = False`
`Rows("1:9").Select`
`Range("A9").Activate`
`Selection.Delete Shift:=xlUp`
`Sheets("BioME-Box- (3)").Select`
`Rows("1:13").Select`
`Selection.EntireRow.Hidden = False`
Rows("1:9").Select
Range("A9").Activate
Selection.Delete Shift:=xlUp
It sounds like you are talking about Validation lists as your "drop down" lists. If so then they might be getting their options from a another range somewhere else. So if you delete a range that the validation lists are using then all of their options disappear. I don't know if this is your problem. But you can copy a validation list and paste only its value, not the whole list, this way.
Sub Macro1()
Range("D3").Select ' This is the validation list
Selection.Copy
' Change "SomeOtherRangeHere" to any cell you want to
Range("SomeOtherRangeHere").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Try this one. Be sure to change mainWS to the worksheet you are copying to. I used sheet1 but you may be using another. In this sub it copies everything below Row 9 of all sheets and pastes them to the first available row in sheet1.
Sub Macro1()
Dim ws As Worksheet, mainWS As Worksheet
Dim wsLastRow As Long, mainWSlastRow As Long, wsLastCol As Long
Set mainWS = Sheet1 ' Change this to the sheet you are copying everthing to
For Each ws In ThisWorkbook.Worksheets
def = mainWS.Name
abc = ws.Name
If ws.Name <> mainWS.Name Then ' Make sure to not copy from the sheet yuo are copying to
wsLastRow = ws.UsedRange.Rows.Count
wsLastCol = ws.UsedRange.Columns.Count
On Error Resume Next
mainWSlastRow = Sheet1.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
If Err.Number = 91 Then
mainWSlastRow = 1
On Error GoTo 0
End If
ws.Range("A10:" & Chr(wsLastCol + 64) & wsLastRow).Copy Destination:=mainWS.Range("A" & mainWSlastRow + 1)
End If
Next ws
Set mainWS = Nothing
Set ws = Nothing
End Sub
While copying data from one Excel sheet to another workbook I have to paste data with the same format because each cell has interior color. I will also delete the data from the original sheet which I copied from. Is it possible to keep the source formatting?
Workbooks.Add
Set Outbook1 = ActiveWorkbook
OutBook.Activate
OutBook.Sheets("Sheet6").Select
Lines = ActiveSheet.Range("A65536").End(xlUp).Row
Range("A1:N" & Lines).Select
Selection.Copy
Outbook1.Activate
Outbook1.Sheets("Sheet1").Range("A1").PasteSpecial (xlPasteAll)
You can keep the source formatting (as long as it's not conditional formatting), using the PasteSpecial xlPasteAll command.
Recommendation: It's always better if you stay from Activate , Select and Selection, instead use referenced Workbooks and Sheets.
(for more details go to How to avoid using Select in Excel VBA macros )
Code
Option Explicit
Sub CopyBetweenSheets()
Dim Outbook1 As Workbook
Dim OutBook As Workbook
Dim Lines As Long
Set OutBook = ThisWorkbook
Set Outbook1 = Workbooks.Add
With OutBook
With .Sheets("Sheet6")
' find last row in Column A in "Sheet6"
Lines = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1:N" & Lines).Copy
End With
End With
' paste to "A1" in "Sheet1" in the new workbook
Outbook1.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteAll
End Sub