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
Related
How should write the code so that it skips sheet1?
Sub Clear_All()
Dim Ws As Worksheet
For Each Ws In ActiveWorkbook.Worksheets
Ws.Range("A11:F800").ClearContents
Next Ws
End Sub
The standard way would be something like
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name <> "Sheet1" Then Ws.Range("A11:F800").ClearContents
Next Ws
but, if Sheet1 were already the left-most tab in the workbook then you could do so more simply
Dim i as Long
For i = 2 to Worksheets.Count
Worksheets(i).Range("A11:F800").ClearContents
Next i
I am trying to write a macro that will look through all sheets in the workbook, and if a sheet name contains "blank", to rename that sheet with the value in cell C1.
Here is what I have so far:
Sub Rename()
Dim ws As Worksheet
Dim sheetBlank As Worksheet
Set sheetBlank = ActiveWorkbook.ActiveSheet
Dim nameCell As Range
Set nameCell = ActiveSheet.Range("C1")
For Each ws In Sheets
If sheetBlank.Name Like "*blank*" Then
sheetBlank.Name = nameCell.Value
End If
Next ws
End Sub
Now, this does rename the first active sheet, but it is not making any changes to the rest of them. What am I doing wrong?
You're referring to the wrong worksheet:
Sub Rename()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "*blank*" Then
ws.Name = ws.Range("C1").Value
End If
Next ws
End Sub
You set your objects outside the loop and never touch them again.
If you're going to use "ActiveSheet" you need to .Activate each sheet in order to work, but that's not a good approach since your iterator (ws) represents the sheet object.
Public Sub Rename()
Dim Ws As Worksheet
For Each Ws In Worksheets
If InStr(1, Ws.Name, "blank", vbTextCompare) > 0 Then _
Ws.Name = Ws.Range("C1").Value2
Next Ws
End Sub
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 want to copy data from worksheets in workbook "Miz" to worksheets in workbook "Prime" by the worksheets names. meaning, i want the data from worksheet "assets" in Miz to be copied to worksheet "assets" in workbook "Prime" by loop (cause i have many worksheets) and so on for other worksheets.
p.s
i got the code to work but it doesn't loop through all the sheets. it only copies the first one and that's it.
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim WsSource As Workbook
Dim WsTarget As Workbook
Dim LastCell As Variant
Set WsSource = Workbooks("Prime.xlsm")
Set WsTarget = Workbooks("Miz.xlsm")
WsTarget.activate
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
If ActiveWorkbook.Worksheets(I).Name = WsSource.Worksheets(I).Name Then
WsTarget.activate
LastCell = Range("A1").SpecialCells(xlCellTypeLastCell).Address
ActiveSheet.Range("A1", LastCell).Select
Selection.Copy
WsSource.activate
ActiveWorkbook.Worksheets(I).activate
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteAll
End If
Next I
End Sub
This could be done better, but i'm tired. The code loops through each workbook and copies the used range of the source workbook to the destination workbook range F1. Both workbooks must be open, or else you will receive the Subscript out of range error.
Sub WsLoop()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim WsSource As Workbook
Dim WsTarget As Workbook
Dim Rng As Range
Set WsSource = Workbooks("Miz.xlsm")
Set WsTarget = Workbooks("Prime.xlsm")
For Each ws In WsSource.Sheets
Set Rng = ws.UsedRange
For Each ws1 In WsTarget.Sheets
If ws.Name = ws1.Name Then
Rng.Copy Destination:=ws1.Range("F1")
End If
Next ws1
Next ws
End Sub
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