I am new to macro and I am struggling with creating macro that will allow me to copy and paste the same range of cells from all sheets in worksheet and paste them in the first sheet in the next available cell. I know that is has to be done with the combination of loop and lastrow. Unfortunately, all my attempts fail
This is the macro that I would like to run through all sheet, but the sheets name is different
Sub Macro10()
'
' Macro10 Macro
'
'
Sheets("1449GW.WLWaterLevel.0sec").Select
Range("H1:Y2").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
Try this. Two versions as not sure what you're asking.
If you are copying the same range from a single sheet to multiple sheets
Sub Macro10()
Dim ws As Worksheet, ws1 As Worksheet
Set ws1 = Worksheets("1449GW.WLWaterLevel.0sec")
For Each ws In Worksheets
If ws.Name <> ws1.Name Then
ws1.Range("H1:Y2").Copy ws.Range("A" & Rows.Count).End(xlUp)(2)
End If
Next ws
End Sub
If you are copying the same range from multiple sheets to a single sheet
Sub Macro10()
Dim ws As Worksheet, ws1 As Worksheet
Set ws1 = Worksheets("Sheet1")
For Each ws In Worksheets
If ws.Name <> ws1.Name Then
ws.Range("H1:Y2").Copy ws1.Range("A" & Rows.Count).End(xlUp)(2)
End If
Next ws
End Sub
Related
I have a workbook contain about 50 worksheets (sheet 1, sheet 2, sheet 3,........, sheet 50). I want to get the sheet name as a column infront of my data in each sheet. I used following code for that.
Sub tgr1()
Dim ws As Worksheet
Dim wsDest As Worksheet
Set wsDest = Sheets("Sheet1")
For Each ws In ActiveWorkbook.Sheets
If ws.Name <> wsDest.Name Then
ws.Range("A:A").Insert Shift:=xlToRight
'Selection.Insert Shift:=xlToRight
ws.Range("A12").FormulaR1C1 = _
"=IF(RC[1]>0,MID(CELL(""filename"",R[-11]C[1]),FIND(""]"",CELL(""filename"",R[-11]C[1]))+1,255),"""")"
ws.Range("A12").Copy
ws.Range("A13:A500").PasteSpecial xlPasteFormulas
ws.Range("A12:A500").Copy
ws.Range("A12:A500").PasteSpecial xlPasteValues
End If
ActiveWorkbook.Save
Next ws
But this code isn't working for all the sheets i have. it applies to random sheets. What should i do to make it apply for all the sheets.
1. Change ActiveWorkbook to ThisWorkbook
2. To get the worksheet name all you need is ws.Range("A12").Value = Ws.Name
3. No point saving the workbook each time the loop runs. Do it outside the loop.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim wsDest As Worksheet
Set wsDest = Sheets("Sheet1")
For Each ws In ThisWorkbook.Sheets
If ws.Name <> wsDest.Name Then
ws.Columns(1).Insert Shift:=xlToRight
ws.Range("A12:A500").Value = ws.Name
End If
Next ws
ThisWorkbook.Save
DoEvents
End Sub
I need help with the code. I want to merge all rows from few sheets except header in one sheet in Excel.
Here is the code:
Dim ws As Worksheet
Dim sh As Worksheet
Set sh = Sheets("P&L_consolidation")
For Each ws In Sheets
If ws.Name <> "Zero's" Then
ws.Range("A2", ws.Range("U"& Rows.Count).End(xlUp)).Copy sh.Range("A"& Rows.Count).ENd(xlUp)(2)
End if
Next ws
This code works if the sheet has some data in it, but the problem is if some sheet contains only header then this code copy that header and paste it to the merged sheet. In that case I just want to skip that sheet.
Please, can somebody help me?
Something like this should work for you:
Sub tgr()
Dim wb As Workbook
Dim ws As Worksheet
Dim wsDest As Worksheet
Set wb = ActiveWorkbook
Set wsDest = wb.Worksheets("P&L_consolidation")
For Each ws In wb.Worksheets
If ws.Name <> "Zero's" Then
With ws.Range("A2", ws.Cells(ws.Rows.Count, "U").End(xlUp))
If .Row >= 2 Then .Copy wsDest.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
End With
End If
Next ws
End Sub
I want to copy all columns from "B" until the end of the sheet into a new sheet named "combined". The Header table in sheets "Combined" is the same of every sheets ("A").
Sub Combine()
' Sheets(1).Select
' Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A1").EntireColumn.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
Dim ws As Worksheet
Dim wsDest As Worksheet
Set wsDest = Sheets("Combined")
For Each ws In ActiveWorkbook.Sheets
If ws.Name <> wsDest.Name Then
ws.Range("B1", ws.Range("B1").End(xlToRight).End(xlDown)).Copy
wsDest.Cells(1, Columns.Count).End(xlToLeft).Offset("B").PasteSpecial xlPasteValues
End If
Next ws
End Sub
.Offset("B") isn't a valid syntax
to shift one column to the right you want .Offset(, 1)
Dim ws As Worksheet
Dim wsDest As Worksheet
Set wsDest = Sheets("Combined")
For Each ws In ActiveWorkbook.Sheets
If ws.Name <> wsDest.Name Then
ws.Range("B1", ws.Range("B1").End(xlToRight).End(xlDown)).Copy
wsDest.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial xlPasteValues
End If
Next ws
I want to delete the first column(A:A) in each sheet except in the first or the current sheet. Can somebody help me.
I used the following code which deletes first column from each sheet.
Sub deletefirstcolum()
Dim ws As Worksheet
For Each ws In Sheets
ws.Cells(1, 1).EntireColumn.Delete
Next ws
End Sub
Please help. How do I exclude first or current sheet.
Put an If condition on the worksheet:
Sub deletefirstcolum()
Dim ws As Worksheet
For Each ws In Sheets
If Not ws Is ActiveSheet Then
ws.Cells(1, 1).EntireColumn.Delete
End If
Next ws
End Sub
Test whether ws = to the active sheet:
Sub deletefirstcolum()
Dim aWs As Worksheet
Set aWs = ActiveSheet
Dim ws As Worksheet
For Each ws In Sheets
If aWs.Name <> ws.Name Then
ws.Cells(1, 1).EntireColumn.Delete
End If
Next ws
End Sub
I am trying to copy column A from one sheet "OPT1"
to the same column in multiple sheets - "OPT1_1", OPT1_2" etc
but it doesn't seem to like the range?
Sub Copy_MN()
Dim ws As Worksheet
For Each ws In Worksheets
Sheets("OPT1").Select
Range("A:A").Copy
If ws.Name Like "OPT1_*" Then
'ActiveSheet.Select
ws.Range("A:A").Select
ActiveSheet.Paste
End If
Next ws
End Sub
Here's my proposition:
Sub Copy_MN()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.name Like "OPT1_*" Then
ws.Range("A:A").Value = Sheets("OPT1").Range("A:A").Value
End If
Next ws
End Sub