I basically just need to know how to copy a header from sheet one that goes from A1-O1 into sheet two, three, four, five and so on...they all have the same header. Sheet one is on the right and sheet two is left and increases to the left. I tried this which I found on some website but it says object required. The error is Runtime Error 424
mainworkBook.Sheets(“Sheet1”).Rows(1).EntireRow.Copy
mainworkBook.Sheets(“Sheet2”).Range(“A1”).Select
mainworkBook.Sheets(“Sheet2”).Paste
A small loop code.let me know if it works.
Sub COPYPASTeHEADER()
Dim K As Integer
For K = 2 To ActiveWorkbook.Sheets.Count
Sheets("All_Data").Range("A1:O1").COPY Sheets(K).Range("A1")
Next
End Sub
You can do something like this instead of using Select:
For Each Sheet In ThisWorkbook.Sheets
ThisWorkbook.Sheets("ALL_DATA").Rows(1).Copy Destination:=Worksheets(Sheet.Name).Range("A1")
Next
This will loop through each sheet in your workbook, take the range you provided (row 1 from Sheet1), and paste it to each sheet by referencing the Name property of each Sheet you are looping through.
The error may have been from the workbook variable, as that is the only thing that is unclear.
I would also recommend looking into this post: How to avoid using Select in Excel VBA macros as it is tremendously helpful in avoiding Select/Activate when possible, which is a common occurrence among those who learn VBA through recording Macros.
Let me know if it works for you.
This is an excellent place to use a loop. For each sheet in the workbook, paste the same header.
Sub forEachWs()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Call pasteContents(ws)
Next
End Sub
Sub pasteContents(ws as Worksheet)
** Your code goes here
End Sub
EDIT: The ** section could be as such:
Sub pasteContents(ws as Worksheet)
ActiveWorkbook.Sheets(“Sheet1”).Rows(1).EntireRow.Copy
ActiveWorkbook.Sheets(ws).Range(“A1”).Select
ActiveWorkbook.Sheets(ws).Paste
End Sub
Or it could also be...
Sub pasteContents(ws as Worksheet)
ActiveWorkbook.Sheets("Sheet1").Rows(1).Copy Destination:=Worksheets(ws).Range("A1")
End Sub
Related
Situation
Trying to copy a range of cells that include formulas from worksheet called "Sheet1" to the rest of other worksheets I found that I could do it performing "Fill Across Worksheets". It worked fine, so my next step was to record a Macro for it to be more efficient and worked just fine too.
The Problem
The problem is that when I include a new worksheet and run the Macro, the Macro does not consider the new worksheet so this last worksheet doesn't get updated.
I am including below the code created by the macro. In it I can see that it's including only the worksheets I have now in the workbook, so this is where I need help.
( My excel is in Spanish so when you read Ctrl+Mayus+Q, Mayus means Shiftkey )
Help
What I need is a way to modify this Macro so when it runs it will check and update all worksheets. Or, maybe it's because a Macro can't do this I may need a VBA code ? If this VBA is the way to resolve it, can you help me here with this ?
I appreciate all help
Thank you
Javier
Sub Macro2()
'
' Macro2 Macro
'
' Acceso directo: Ctrl+Mayús+Q
'
Range("A5:D12").Select
Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")).Select
Sheets("Sheet1").Activate
ActiveWindow.SelectedSheets.FillAcrossSheets Range:=Selection,
Type:=xlAll
Sheets("Sheet1").Select
End Sub
This is a work around, concerning that you want all the worksheets to have the value of the first worksheet in range A5:D12:
Sub TestMe()
Dim ws As Worksheet
Dim selAddress As String
selAddress = "A5:D12"
For Each ws In Worksheets
'ws.Range(selAddress).Value2 = Worksheets(1).Range(selAddress).Value2
ws.Range(selAddress).Formula = Worksheets(1).Range(selAddress).Formula
Next ws
End Sub
See How to avoid using Select in Excel VBA.
I tried many different sample codes before posting this, but I can't get any of them to work.
I need this to run not just in the active sheet but on all sheets in my file.
On Error Resume Next
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Hope someone is able to help.
You need to loop over the sheets in the workbook and manipulate each one individually:
Dim sheet As Worksheet
For Each sheet In ActiveWorkbook.Worksheets
sheet.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next
The solution of Alex K. is OK, only check if the sheet is empty or not, otherwise you will have an error with "SpecialCells" :
Dim sheet As Worksheet
For Each sheet In ActiveWorkbook.Worksheets
If WorksheetFunction.CountA(sheet.Cells) <> 0 Then
sheet.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If
Next
End Sub
I want to write a simple VBA macro to copy the data in a range that corresponds to the block of cells around an active cell in Sheet1 and Paste it in Sheet2. (preferably in the same address as of in Sheet1).
The code I have written is:
Option Explicit
Dim Cello As Range
Sub CopyCurrentRegion2()
Set Cello = Worksheets("Sheet1").Range(ActiveCell.Address)
Cello.CurrentRegion.Copy Sheets("Sheet2").Range(Cello)
End Sub
Please correct this prog. It is giving run time error: 1004.
Consider:
Sub CopyStuff()
With ActiveCell.CurrentRegion
.Copy Sheets("Sheet2").Range(.Address)
End With
End Sub
is there a vba way to prevent rearranging of worksheets? For example: Sheet1, Sheet2, Sheet3 can't be drag to a new order of Sheet3, Sheet2, Sheet1.
For example: I have code Sheet1.cells(1, 1).value and by rearranging of sheets it changes object references. I need to disable this so the user doesn't inadvertently break code. Perhaps a failure in planning but none the less I'm stuck with it at this point until a rewrite is possible.
Would need a solution for 2003, 2007, 2010 and beyond if at all possible.
I do not see any topics or solutions on the net, in the object browser, or on stackoverflow so would appreciate your help/references you may have to offer.
Thanks.
I see the issue with the code.
Main 1
Sub Main(sheetIndex as integer)
Dim ws as worksheet
Dim x as String
Set ws = Sheets(sheetIndex)
x = ws.Cells(1, 1).value
End sub
Changed to:
Main Sheet1
Sub Main(sheetIndex as Object)
Dim x as String
x = sheetIndex.Cells(1, 1).value
End sub
Rearranging of worksheets doesn't break code now. Now I need to dig through the code and find more instances. Thanks Tim, Alexandre.
I am trying to figure this out all day. This is what I need to accomplish:
Using GetFile select a number of workbooks without opening them.
Compare Cell A2 of selected workbooks indiviually in loop to a reference workbook.
If Cell A2 of the selected workbook equals the numerical value of the numerical value within the reference workbook contained within column A then copy/past column B's text in the corresponding cell of the matched reference workbook cell to M2 of the selected workbook.
Sounds complicated but let me demonstrate. The letters represent column names.
Selected Workbook
A2=12 M2= ""
Reference Workbook
A2=12 B2=milk, protein
Desired result:
Selected Workbook
A2=12 M2=milk, protein
So far this is the code I have:
Sub Click()
Dim rCell As Range, vVal1, vVal2
Dim wbCheck As Workbook
For Each rCell In Workbooks("2.xls").Worksheets(1).Range("A1:C100")
vVal1 = rCell
vVal2 = ThisWorkbook.Worksheets(1).Range(rCell.Address)
If IsNumeric(vVal1) And IsNumeric(vVal1) Then
If vVal1 = vVal2 Then
rCell.Interior.ColorIndex = 3
ElseIf vVal1 < > vVal2 Then
End If
End If
Next rCell
End Sub
Why do you need a VBA code for this?
This can be achieved using an Excel Formula.
Paste this in M2 and copy it down
=IF(A2='C:\[Ref.xlsx]Sheet1'!A2,'C:\[Ref.xlsx]Sheet1'!B2,"")
My Assumptions (Please change as applicable)
The reference file name is Ref.xlsx
You are pulling data from Sheet1 of reference file
The Ref.xlsx is in C:
EDIT
Even if you want to use VBA, you can also do this.
Sub Sample()
Application.Calculation = xlCalculationManual
ThisWorkbook.Sheets("Sheet1").Range("M2").Formula = _
"=IF(A2='C:\[Sample.xlsx]Sheet1'!A2,'C:\[Sample.xlsx]Sheet1'!B2,"""")"
Application.Calculation = xlCalculationAutomatic
End Sub
The above formula or code is beneficial becuase of what you mentioned in 1st point Using GetFile select a number of workbooks without opening them. If you do not want to open the file then the formula or formula in VBA is the way to go :)
I solved my own question. The answer was to use VLookup.
=VLOOKUP(I2, 'C:\Desktop\Merge[ISReference.xlsx]Reference'!B2:G1923, 6, FALSE)
I am surprised no one suggested this to me. Given its simplicity I was able to build this function into some code I built to run through a FSO filedialog picker on a form in access and link external workbooks with Vlookup.
Thanks Siddarth for giving the proper direction of embedding a function instead of crazy iterated loop.