Free Microsoft Excel 2013
Quick Reference
Free Microsoft 2013 Quick Reference Guide

Free Microsoft Excel 2013 Quick Reference

vba pastespecial

HI,

i am tring to copy data form one spreadsheet to another within the sam
workbook. i need to use the paste special, adding the values. I wrot
the folowwing code and it goes trough ok. it copies the information bu
it does not paste. and it does not show any problem.

anyone could help?

Thanks

Worksheets("dados").Cells(c, E).Select
Selection.Copy
x = c + 1
z = f + 2
Worksheets("Plan").Select
Cells(x, z).PasteSpecial Operation:=xlPasteSpecialOperationAd

-----------------------------------------------
~~ Message posted from http://www.ExcelTip.com
~~View and post usenet messages directly from http://www.ExcelForum.com


Post your answer or comment

comments powered by Disqus
I am new to VBA. I have pieced together the following code to copy a row of data and paste it as the last row. However, the row of data contains a Data Validation list which I would like to paste. I cannot find how to use Pastespecial to do this for me.

Can someone help?


	VB:
	
 PasteValToNextRow() 
     '
     ' newRow Macro
     '
     
     '
    sCurrentSheet = "Input" 
    Worksheets(sCurrentSheet).Activate 
     
    Application.ScreenUpdating = False 
     
    Dim NextRow As Range 
    Set NextRow = Sheets("Input").Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0) 
    Sheets("Input").Range("A3").EntireRow.Copy 
    NextRow.PasteSpecial (xlFormats) 
     
    Application.CutCopyMode = False 
    Application.ScreenUpdating = True 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Does anyone see a way to paste the range I have identified as values only and not formula's. I can't seem to figure it out using the .PasteSpecial code.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A1")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then

Sheets("Sheet1").Range(Range("A1")).CurrentRegion.Copy Sheets("Sheet2").Range("F1")
'Uses Variable in A1 to determine range to copy to Sheet 2 Cells F1:size of range
End With
End If
End Sub

Your help is appreciated!

Ryan

I can't get PasteSpecial to work right, so I have to add the ClearContents line. Any idea what I'm doing wrong?

Private Sub Newrecord_Click()
    Range("4:4").Rows.Insert True
    Worksheets("sheet1").Range("A5:R5").Copy
    Worksheets("sheet1").Range("A4:R4").PasteSpecial Paste:=xlPasteFormats
    Worksheets("sheet1").Range("A4:R4").PasteSpecial Paste:=xlPasteFormulas
    Worksheets("sheet1").Range("A4:G4").ClearContents
End Sub


I'd like to be able to copy a column which includes formulae, values
and cell background colour formatting, and paste it to another column
which has different colour backgrounds.

I need to keep the formulae from the copied column and the formatting
for the object column.

I realise I can do a PasteAll, and then reset the original colours
with another line or two of code, but a single operation would be
preferable.

Any suggestions please?

Usual TIA

__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________

While copying from one range to other I want to copy column widths to destination range. If I do this operation manually ( Edit>Paste Special>Column Width ) and record macro, it generates a code
Selection.PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
However if I run this macro it gives a runtime error. I have gone through Excel help available on VBA. PasteSpecial method does not list xlColumnWidths as available parameter. I wonder how macro records it as a valid parameter.
Any idea how I can copy column widths from one range to other in one go? I can loop through all the source and destination columns and copy widths one by one but I a looking for copying widths of all the colmns in one go.

A V Veerkar

Hi Everyone,
I have a question similar to that ask before but slightly modified. My workbook contains 4 worksheets i.e. "General", "Inputs", "Monthly Profile", and "Annual Profile". Since i am a beginner to VBA, I need a VBA Code that will open a new workbook and copy the last three sheets as past special with the same format containing only values & not formulas. I already built a code but it only copy one sheet to the new workbook and not the other two at the same time. the code is;


	VB:
	
 CopySheetValues() 
    Dim ws As Worksheet, wb As Workbook 
    Set ws = ActiveSheet 
    Set wb = Workbooks.Add 
    ws.Cells.Copy 
    ActiveSheet.Cells.PasteSpecial Paste:=xlValues 
    ActiveSheet.Cells.PasteSpecial Paste:=xlFormats 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
i want a VBA code that will copy the whole three sheets instead of one. Your prompt response will be appreciated. Thanks & Regards, Shakeel

"Ed" > wrote in message
...
> When you bring up Paste Special witha right click, you can choose to paste
> only formats, or formulas, or values, etc., but not more than one. With
> VBA, can I PasteSpecial format AND values, but NOT formulas?

Hi Ed,

VBA is the same as the UI in this regard. You can perform as many
PasteSpecial operations in a row as you like, though, in order to get the
combination you're after.

--
Rob Bovey, MCSE, MCSD, Excel MVP
Application Professionals
http://www.appspro.com/

* Please post all replies to this newsgroup *
* I delete all unsolicited e-mail responses *

Hi,

I've read the other message re: exporting data to powerpoint and found it useful, however I do not need my Excel files embedded in PowerPoint.

Hence, my question is regarding using Excel VBA to paste data into Powerpoint as "Picture(Enhanced Metafile)" or "Picture"

I'm using Excel/PowerPoint 97 and understand that I can do this using PasteSpecial method under XL/PPT 2002.

Is there a method of doing this under XL/PPT 97?

Many thanks,

First, I DO understand what SkipBlanks actually does.

What i'm doing is running a simple macro to copy values from one workbook to another. Everything is working fantastically except one glitch. The macro copies a range of cells and copies over the values to the other workbook. These cells it copies do reference to cells that contain formulas. The logics in the cells are told to return blank if it doesn't meet certain criteria. (ex. =IF(A1>1,1,""))

This I thought would work well. The values it copes are displayed from these types of IF logics. If they returned blank then I thought skipblanks in VBA wouldn't copy the blank cell. But apparently Excel references to weather or not the cell is truly blank, as in no formulas no nothing.

Is this true?

Here is a sample of the code.

lgt
= Worksheets("Backend").Range("B2")     // The workbook that gets pasted to changes daily. Another macro
updates this
'
With Workbooks("Sample1.xls").Worksheets("Page 1")
     .Range("A1:G1").Copy
End With
With Workbooks(lgt).Worksheets("Page 2")
     .Range("B1:H1").PasteSpecial _
          Paste:=xlPasteValues, SkipBlanks_ = True
EndWith
It does that several times to different cells. But it always copies the cells where forumlas are supposed to be returning blank (and the ones I want to copy), and pasting blank over the data I don't want to overwrite while pasting the data I want. Any ideas on this?

Hi Guys,

I am very new to vba and came up with the following code to filter through a data validation list, copy two worksheets into a new workbook, and save that workbook (values,formats) into one folder. The macro loops through the validation list in the cell listed and works.

However, it takes a bit of time to go through the entire list and seems like there is some instability with the code as Excel will sometimes fail/crash.

Any ideas on how to make the following code simplier/ more friendly to excel.

Thanks!


	VB:
	
 LoopListRange() 
    Dim rng As Range, cell As Range 
    Dim wSh As Worksheet 
    Dim foldername As String 
    Dim WSNew As Worksheet 
    Dim ws As Worksheet 
     
     'Fill in the pathfolder where you want the new folder with the files
     'you can use also this "C:Users(YOUR USERNAME)test"
    MyPath = Application.DefaultFilePath 
     'Add a slash at the end if the user forget it
    If Right(MyPath, 1)  "" Then 
        MyPath = MyPath & "" 
    End If 
     'Create folder for the new files
    foldername = MyPath & Format(Now, "yyyy-mm-dd hh-mm-ss") & "" 
    MkDir foldername 
     
     ' The following syntax is used to filter on "A12" to reference the position of the validation list (Drop Down)
    Set rng = Evaluate(ActiveSheet.Range("C5").Validation.Formula1) 
    For Each cell In rng 
        ActiveSheet.Range("C5").Value = cell.Value 
        Sheets(Array("Incentive Scorecard", "Incentive Details")).Copy 
        ActiveWorkbook.SaveAs foldername & cell.Value 
         ' Copies Entire open workbook and repastes as values( Hardcodes all data in the workbook)
        Worksheets.Select 
        Cells.Select 
        Selection.Copy 
        Selection.PasteSpecial Paste:=xlPasteValues 
        ActiveSheet.Select 
        Application.CutCopyMode = False 
         
        ActiveWorkbook.Close SaveChanges:=True 
    Next 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hello All,

I am after some VBA code (Excel 2003) to conditionally format cells, dependent on a master key. I am after matching an etry in a cell to the key, then looking up that cell's formatting and applying it to the initial cell. Blank cells should be left white.

I currently have a hard-programmed conditional formatting VBA code which works, but offers no flexibility (also, although it runs in a WoksheetChange() sub, it generates lots of errors if I try to run it as a macro - I am after code for both). The data (C1:D1) will always be text.

A B C D E F G 1 I T M X J 2 Key: 3 I 4 T 5 M 6 X 7 J

So far I have something that looks like this (absolute cell references are different as the above is a simplification), but it does not work:

	VB:
	
 Range) 
     
    If Not Intersect(Target, Range("D6:EV49")) Is Nothing Then 
         
        Application.EnableEvents = False 
        Target = UCase(Target) 
        Application.EnableEvents = True 
         
        If Target.Value = Range("A62").Value Then 
            Range("A62").Select 
            Selection.Copy 
            Target.Select 
            Selection.PasteSpecial Paste:=xlPasteFormats 
            Target = UCase(Target) 
            Exit Sub 
             
            If Target.Value = Range("A63").Value Then 
                Target.Interior.ColorIndex = 36 
                Exit Sub 
                 
                If Target.Value = Range("A64").Value Then 
                    Target.Interior.ColorIndex = 44 
                    Exit Sub 
                     
                    If Target.Value = Range("A65").Value Then 
                        Target.Interior.ColorIndex = 7 
                        Exit Sub 
                         
                        If Target.Value = Range("A66").Value Then 
                            Target.Interior.ColorIndex = 4 
                            Exit Sub 
                             
                            If Target.Value = Range("A67").Value Then 
                                Target.Interior.ColorIndex = 35 
                                Exit Sub 
                                 
                                If Target.Value = Range("A68").Value Then 
                                    Target.Interior.ColorIndex = 36 
                                    Exit Sub 
                                     
                                    If Target.Value = Range("A69").Value Then 
                                        Target.Interior.ColorIndex = 44 
                                        Exit Sub 
                                         
                                        If Target.Value = Range("A70").Value Then 
                                            Target.Interior.ColorIndex = 7 
                                            Exit Sub 
                                             
                                            If Target.Value = Range("A71").Value Then 
                                                Target.Interior.ColorIndex = 7 
                                                Exit Sub 
                                                 
                                                If Target.Value = Range("A72").Value Then 
                                                    Target.Interior.ColorIndex = 7 
                                                    Exit Sub 
                                                     
                                                    If Target.Value = Range("A73").Value Then 
                                                        Target.Interior.ColorIndex = 7 
                                                        Exit Sub 
                                                         
                                                        If Target.Value = Range("A74").Value Then 
                                                            Target.Interior.ColorIndex = 7 
                                                            Exit Sub 
                                                             
                                                            If Target.Value = Range("A75").Value Then 
                                                                Target.Interior.ColorIndex = 7 
                                                                Exit Sub 
                                                                 
                                                                If Target.Value = Range("A76").Value Then 
                                                                    Target.Interior.ColorIndex = 7 
                                                                    Exit Sub 
                                                                     
                                                                    If Target.Value = Range("A77").Value Then 
                                                                        Target.Interior.ColorIndex = 7 
                                                                        Exit Sub 
                                                                         
                                                                        If Target.Value = Range("A78").Value Then 
                                                                            Target.Interior.ColorIndex = 7 
                                                                            Exit Sub 
                                                                             
                                                                            If Target.Value = Range("A79").Value Then 
                                                                                Target.Interior.ColorIndex = 7 
                                                                                Exit Sub 
                                                                                 
                                                                                If Target.Value = Range("A80").Value Then 
                                                                                    Target.Interior.ColorIndex = 7 
                                                                                    Exit Sub 
                                                                                     
                                                                                    If Target.Value = Range("A81").Value Then

                                                                                        Target.Interior.ColorIndex = 7 
                                                                                        Exit Sub 
                                                                                         
                                                                                        If Target.Value = Range("A82").Value
Then 
                                                                                            Target.Interior.ColorIndex = 7 
                                                                                            Exit Sub 
                                                                                             
                                                                                            If Target.Value =
Range("A83").Value Then 
                                                                                                Target.Interior.ColorIndex =
7 
                                                                                                Exit Sub 
                                                                                                 
                                                                                                If Target.Value =
Range("A84").Value Then 
                                                                                                   
Target.Interior.ColorIndex = 7 
                                                                                                    Exit Sub 
                                                                                                     
                                                                                                    If Target.Value =
Range("A85").Value Then 
                                                                                                       
Target.Interior.ColorIndex = 7 
                                                                                                        Exit Sub 
                                                                                                         
                                                                                                        If Target.Value =
Range("A86").Value Then 
                                                                                                           
Target.Interior.ColorIndex = 7 
                                                                                                            Exit Sub 
                                                                                                             
                                                                                                            If Target.Value =
Range("A87").Value Then 
                                                                                                               
Target.Interior.ColorIndex = 7 
                                                                                                                Exit Sub 
                                                                                                                 
                                                                                                            End If 
                                                                                                        End If 
                                                                                                    End If 
                                                                                                     
                                                                                                End If 
                                                                                            End If 
                                                                                        End If 
                                                                                         
                                                                                    End If 
                                                                                End If 
                                                                            End If 
                                                                             
                                                                        End If 
                                                                    End If 
                                                                End If 
                                                                 
                                                            End If 
                                                        End If 
                                                    End If 
                                                     
                                                End If 
                                            End If 
                                        End If 
                                         
                                    End If 
                                End If 
                            End If 
                             
                        End If 
                    End If 
                End If 
                 
            End If 
        End If 
    End If 
     
    On Error Goto 0 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Thanks for looking.

Hi, all. I am newbie for VBA Macro Programming. My task is to create a Excel Macro Programming by copy the wide range of data without open any workbook and paste it in the current workbook. My concept of the programming is i can select the file before proceed for the copy paste event. If no file select, the message box will show up and tell the use no fill selected. Example my data at Book1.xlsm. And i want to copy from range A1 to J20 and paste it at A1 of the Book3.xlsm. But, I now stuck at the middle and having unclear error. The macro can copy and paste it very well. But at the no file select event, it will pop out an error message state that 'False.xlsx' cannot be found. bla bla bla..... Can any pros give me any idea or solution for the problem? Thanks.

My code as below:

	VB:
	
 CopyRanges() 
    Dim wb As Workbook 
    Dim Fname As String 
     
    ChDrive "D" 
    ChDir "D:DocumentsUniMAPInTraTraining" 
    Fname = Application.GetOpenFilename("*,*.xls*", , "Please select file to open") 
     'no file selected
    If Fname = ("*,*.xls*") Then 
        MsgBox "File not selected! Please select a file to open." 
        Exit Sub 
    End If 
    For Each wb In Application.Workbooks 
        If wb.path & "" & wb.Name = Fname Then 
            MsgBox "File " & wb.Name & " is already open" 
             'next line needs fixing - 'Fname' will not activate
             'in case file is open, then just ACTIVATE it
            Exit For 
        End If 
    Next 
     
    If wb Is Nothing Then 
        Set wb = Workbooks.Open(Fname) 
    End If 
    wb.ActiveSheet.Range("A1:J20").Copy 
    ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues 
    Application.DisplayAlerts = False 
     'close 'Fname'
    wb.Close 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hello All,

I am new to VBA. I have a workbook where new rows are added to a few different worksheets every day (about 10 to 30 rows per worksheet).

These rows need to be copied to another workbook. I was successful in using VBA to copy the rows, open the separate workbook, and activate the workbook window. I get an error though when I try to activate sheet2 (subscript is out of range). The same happens when i try to activate other worksheets.

Any help or advice would be appreciated. Thanks.

The code errors out on the following:


	VB:
	
TradeManager.Sheets("Sheet2").Activate 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines

and


	VB:
	
TradeManager.Sheets("Sheet2").Range("A2").Activate 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Below is what I have so far.


	VB:
	
 TransferLALtoInterpolator() 
     
    Dim Interpolator     As String 
    Dim TradeTickets    As String 
    Dim TradeManager    As Workbook 
    Dim NewTrades       As Workbook 
    Dim TC              As Long 
     
    Interpolator = "KRWCommodityInterpolator_Development_23APR12" 
     
    Application.ScreenUpdating = False 
     
    Workbooks.Open Filename:="J:GC Commodity Trade Spreadsheet April2012KRWCommodityInterpolator_Development_23APR12.xlsm" 
     
    Set NewTrades = Workbooks("New Trade Spreadsheet_Development_24APR12") 
    Set TradeManager = Workbooks("KRWCommodityInterpolator_Development_23APR12") 
     
    TradeManager.Sheets("Sheet2").Activate 
    Rows("2:1000").ClearContents 
     
    NewTrades.Activate 
    With Sheet1 
        .Cells.Copy 
        .Cells.PasteSpecial xlPasteValues 
    End With 
     
    Application.CutCopyMode = False 
     
    Sheet2.Activate 
     
    TC = Range("B10").Value - 1 
     
    Sheet1.Activate 
     
    x = Range("B65536").End(xlUp).Row 
    y = Range("B65536").End(xlUp).Row - TC 
     
    Range("B" & y & ":B" & x).EntireRow.Copy 
     
    Windows(Interpolator).Activate 
    TradeManager.Sheets("Sheet2").Range("A2").Activate 
    Selection.PasteSpecial xlPasteValues 
    Application.CutCopyMode = False 
    ActiveWorkbook.Save 
     
    Application.ScreenUpdating = False 
     
    MsgBox "Next Step: click PREPARE OTC LAL ENERGY FOR TRADE MANAGER", vbOKOnly, "Transfer Complete" 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hi, I have been a long time reader, first time poster.

I am having some issues with a macro I created. I have an excel file that generates a report. My goal is to "export" the main content sheets of the page via vba.

The problem is that the values-only exported copy is unstable and crashes after attempting to close the file immediately after export. This happens on multiple PCs, not only my installation of Excel. I have used this method in the past and have no issues whatsoever. Any suggestion on how I could make this more stable?


	VB:
	
 ExportReport() 
     
     'Sheets to export
    genFile = ThisWorkbook.Name 
     
    exportLoc = Workbooks(genFile).Worksheets("Control").Range("B14") 
    sDate = Format(Workbooks(genFile).Worksheets("Control").Cells(2, 2).value, "yyyy-mm-dd") 
     
    exportSheets = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4") 
     
    Workbooks(genFile).Worksheets(exportSheets).Copy 
     
    For Each ws In ActiveWorkbook.Worksheets 
        ws.Range("A1:AZ1000").Copy 
        ws.Range("A1:AZ1000").PasteSpecial Paste:=xlPasteValues 
    Next ws 
     
    Application.DisplayAlerts = False 
    ActiveWorkbook.SaveAs exportLoc & "FileNameString_" & sDate & ".xlsx" 
    Application.DisplayAlerts = True 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


I have attached the code where I am trying to select a user range thru a subroutine and use this generically to copy from one sheet and paste it to another sheet I am using pastespecial as I want to copy only the format and not the values. The code dos not work and gets stuck at highlighted line in the attachment.the message i get is Run time error 1004 . pasteSpecial method of range class failed Any suggestions to correct this error?


	VB:
	
 
Public UserRange As Range 
 
Sub SelUserRange() 
     'Selects Range based on user inpout
    Set UserRange = Application.InputBox(Prompt:="Please Select Range", Title:="Delete Blank Rows ", Type:=8) 
    Application.Goto UserRange 
     'Msgbox("UserRange is" & UserRange, vbOKOnly, "JRM", 8) As VbMsgBoxResult
End Sub 
 
Sub RangeCopyPaste() 
    Sheets("Sheet1").Select 
    SelUserRange 
    Application.CutCopyMode = False 
    Selection.Copy 
     
    Sheets("COGNI").Activate 
    SelUserRange 
    UserRange.Activate 
    UserRange.PasteSpecial xlPasteFormats 
    Application.CutCopyMode = False 
    Exit Sub 
     
Canceled: 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


The crux of the problem
First sub selects a range to be copied in Sjheet1 as specified by the userSecond subroutine activates a sheet “COGNI”: and tried to paste into a location specified by user thru input boxThe macro is stuck at highlighted point

I have a macro developed on Mac (Excel 2011) which will run on either Mac or Windows (Excel 2003). One of the subs creates a new workbook and copies several sheets from an existing workbook to the new workbook. I also have a variable ("OS") in the macro which has the value of "Mac" or "Win" based on its host.

After copying the sheets to the new workbook, the sub does a Copy/PasteSpecial xlValues in order to eliminate an formulas in the target workbook. The code below works fine on the Mac but stalls in Windows at the PasteSpecial step. I've tried several different coding alternatives but can't get past it. Here is the relevant part of the code:


	VB:
	
 CopyReportSheets(ReportDiv, ReportDivLong, ReportMonth, FolderString, OS) 
    Dim nm As Name 
    Dim ws As Worksheet 
     
    If MsgBox("Create " & ReportDivLong & ", " & ReportMonth & " 2012, monthly report in a new workbook?" & vbCr & _ 
    "New sheets will be pasted as values, named ranges removed" _ 
    , vbYesNo, "New Report ") = vbNo Then Exit Sub 
    Application.StatusBar = "Have patience...  we're working!" 
     
     
    With Application 
        .ScreenUpdating = False 
         
         '       Copy specific sheets
         
        On Error Goto ErrCatcher 
        Sheets(Array("Title", "Dashboard", "Rev Charts", "Rev Chart by Type", "Util Charts", "GP Charts", "NP Charts", "Div
Charts", "" & ReportDiv & " P&L", "Receivables")).Copy 
        On Error Goto 0 
         
         '       Paste sheets as values
         
         
        For Each ws In ActiveWorkbook.Worksheets 
            ws.Cells.Copy 
            ws.Cells.Clear 
            ws.[A1].PasteSpecial xlPasteValues              [U][B] '  This is the step that fails in Windows
(ActiveCell.PasteSpecial xlPasteValues?)[/B][/U]
            ws.Cells.Hyperlinks.Delete 
            Application.CutCopyMode = False 
            Cells(1, 1).Select 
            ws.Activate 
        Next ws 
        Cells(1, 1).Select 
         
         '       Remove named ranges
        For Each nm In ActiveWorkbook.Names 
            nm.Delete 
        Next nm 
         
         '  Customize Title sheet at front
        Sheets("Title").Select 
        Range("A23").Value = ReportDivLong & " Division" 
        Range("A25").Value = ReportMonth & ", 2012" 
         
         '       Save it with the Div Name in the Desktop directory (Mac)
        Dim DesktopFolder As String, strPath As String 
         
         
         ' Call AppleScript to get the Desktop folder
         ' DesktopFolder = MacScript("return (path to desktop folder) as string")
        If OS = "Mac" Then 
            ActiveWorkbook.SaveAs FolderString & ReportDiv & "-" & ReportMonth & "-2012 Report.xls", FileFormat:=57 'Mac
        Else 
            ActiveWorkbook.SaveAs FolderString & ReportDiv & "-" & ReportMonth & "-2012 Report.xls", FileFormat:=56 'Windows
        End If 
        ActiveWorkbook.Close SaveChanges:=False 
         
        .ScreenUpdating = True 
    End With 
    Application.StatusBar = False 
    Exit Sub 
     
ErrCatcher: 
    Application.StatusBar = False 
    MsgBox "Specified sheets do not exist within this workbook" 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines

As alternatives, I've tried Range("A1").PasteSpecial but still get a 1004. Any help would be much appreciated. Also has been tried against Windows Excel 2010. Failure point was the same.

Version: Microsoft Excel 2010 for Windows

Hi
I have a problem with some VBA code I'm trying to change.
It should be a simple instruction to write, so I'm stumped about what I'm doing wrong...

What I need is for the “wsloop” (see code below) to select cell A2 on each worksheet before moving onto the next worksheet
i.e. deselect the “All Cell” selection done previously in the code on each worksheet (up to 10 of them)

I tried the following variations:
.Range("A2").Select
I get a debugging error message (1004) "Method select of object range failed"
or the action is only happening on the first worksheet (depending what I'm trying).

I tried:
Range("A2").Select
(positioned within the wsloop)
The first worksheet moves to that cell, but the following worksheets don't.

I tried:
Cells.Range("A2").Select
(positioned within the wsloop)
The first worksheet moves to that cell, but the following worksheets don't.

I also tried to position the instruction after "End With" and before "Next wsloop" but this didn't work either.

Could someone please tell me what I'm doing wrong and how I should write the instruction so that it works - everything else in the code is working okay.

Thank you very much for your time.

Kind Regards

Deb


	VB:
	
 Marchreport() 
     
    Dim nme As Name 
     
    Dim wsLoop As Worksheet 
     
    Dim lLastRow As Long 
    Dim rFind As Range 
    Dim rFind2 As Range 
     
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    Application.DisplayAlerts = False 
     
    For Each wsLoop In ActiveWorkbook.Worksheets 
        With wsLoop 
            lLastRow = .Cells(Rows.Count, "A").End(xlUp).Row 
            .Range("BO1").Value = "T" 
            .Cells.Copy 
            .Cells.PasteSpecial Paste:=xlValues 
            .Cells.Range("A2").Select               [I][B] 'this is where my problem is'[/B][/I]
             
            .Range("BN:DM").Delete 
            .Buttons.Delete 
        End With 
    Next wsLoop 
     
    …….. ‘The Macro continues doing other tasks’ 
     
    Sub End 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hello, I have the following VBA script setup to run a goal seek.
I have a vector of values to paste into a target cell (one by one), and to run goal seek on each of them. My vector of given values goes from "K38" to "K60". I want to take each of these, copy and past them into cell "E8", then run goal seek such that "E17 = 0.14" by changing cell "E10". I then want to take the value derived in "E10", and paste it in "L38" (next to K38, where I got my original input variable). Then I want to repeat this starting with the next number in "K39"...and paste the result in "L39". Pls see script below. Your help is greatly appreciated!

Range("K38").Select
Selection.Copy
Range("E8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-3
Application.CutCopyMode = False
Range("E17").GoalSeek Goal:=0.14, ChangingCell:=Range("E10")
Range("E10").Select
Selection.Copy
Range("K38").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K38").Select
End Sub

Hey guys, i need some help to optimize vba in my excel field, im still very new to the excel field, below is my code, how will I make this more effective/ faster for excel to process.

Like is there a way i can change the code to copy a range to another range? for example copy D3:D45 to c:g, instead of it copying everything separately??

Thanks in advance


	VB:
	
 save_del_note() 
     '
     ' Save_Data Macro
     ' Macro recorded 10/10/2002 by Roy Cox
     '
     
     
    Application.ScreenUpdating = False 
     
    TEMPLATE_SHEET = "Delivery Note" 
    DATABASE_SHEET = "db_delnote" 
    COUNT_ROW = 1 
    DATABASE_RECORDS = Sheets(DATABASE_SHEET).Range("A1:A10000") 
     
     'To identify the next blank row in the database sheet
     
    For Each DBRECORD In DATABASE_RECORDS 
         
        If DBRECORD  "" Then COUNT_ROW = COUNT_ROW + 1 
         
    Next DBRECORD 
     
     'To copy the data from the template to the database
     
    Sheets(TEMPLATE_SHEET).Select 
     
     'Data Field 1 to database
     
     'ActiveWindow.SelectedSheets.PrintOut
     'ActiveWindow.SelectedSheets.PrintOut
     
     
    Range("DELNUM").Copy 
    Sheets(DATABASE_SHEET).Range("B" & COUNT_ROW).PasteSpecial xlPasteValues 
     
    Range("DRIVER").Copy 
    Sheets(DATABASE_SHEET).Range("C" & COUNT_ROW).PasteSpecial xlPasteValues 
     
    Range("TRUCKREG").Copy 
    Sheets(DATABASE_SHEET).Range("D" & COUNT_ROW).PasteSpecial xlPasteValues 
     
    Range("TIMEOUT").Copy 
    Sheets(DATABASE_SHEET).Range("E" & COUNT_ROW).PasteSpecial xlPasteValues 
     
    Range("PAGE").Copy 
    Sheets(DATABASE_SHEET).Range("F" & COUNT_ROW).PasteSpecial xlPasteValues 
     
    Range("CUSTAD1").Copy 
    Sheets(DATABASE_SHEET).Range("G" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("CUSTAD2").Copy 
    Sheets(DATABASE_SHEET).Range("H" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("CUSTAD3").Copy 
    Sheets(DATABASE_SHEET).Range("I" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("CUSTAD4").Copy 
    Sheets(DATABASE_SHEET).Range("J" & COUNT_ROW).PasteSpecial xlPasteValues 
     
    Range("PARTNUM1").Copy 
    Sheets(DATABASE_SHEET).Range("K" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM2").Copy 
    Sheets(DATABASE_SHEET).Range("L" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM3").Copy 
    Sheets(DATABASE_SHEET).Range("M" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM4").Copy 
    Sheets(DATABASE_SHEET).Range("N" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM5").Copy 
    Sheets(DATABASE_SHEET).Range("O" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM6").Copy 
    Sheets(DATABASE_SHEET).Range("P" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM7").Copy 
    Sheets(DATABASE_SHEET).Range("Q" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM8").Copy 
    Sheets(DATABASE_SHEET).Range("R" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM9").Copy 
    Sheets(DATABASE_SHEET).Range("S" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM10").Copy 
    Sheets(DATABASE_SHEET).Range("T" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM11").Copy 
    Sheets(DATABASE_SHEET).Range("U" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM12").Copy 
    Sheets(DATABASE_SHEET).Range("V" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM13").Copy 
    Sheets(DATABASE_SHEET).Range("W" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM14").Copy 
    Sheets(DATABASE_SHEET).Range("X" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM15").Copy 
    Sheets(DATABASE_SHEET).Range("Y" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM16").Copy 
    Sheets(DATABASE_SHEET).Range("Z" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM17").Copy 
    Sheets(DATABASE_SHEET).Range("AA" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM18").Copy 
    Sheets(DATABASE_SHEET).Range("AB" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM19").Copy 
    Sheets(DATABASE_SHEET).Range("AC" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM20").Copy 
    Sheets(DATABASE_SHEET).Range("AD" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM21").Copy 
    Sheets(DATABASE_SHEET).Range("AE" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM22").Copy 
    Sheets(DATABASE_SHEET).Range("AF" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM23").Copy 
    Sheets(DATABASE_SHEET).Range("AG" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM24").Copy 
    Sheets(DATABASE_SHEET).Range("AH" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("PARTNUM25").Copy 
    Sheets(DATABASE_SHEET).Range("AI" & COUNT_ROW).PasteSpecial xlPasteValues 
     
    Range("QTYO1").Copy 
    Sheets(DATABASE_SHEET).Range("AJ" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO2").Copy 
    Sheets(DATABASE_SHEET).Range("AK" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO3").Copy 
    Sheets(DATABASE_SHEET).Range("AL" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO4").Copy 
    Sheets(DATABASE_SHEET).Range("AM" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO5").Copy 
    Sheets(DATABASE_SHEET).Range("AN" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO6").Copy 
    Sheets(DATABASE_SHEET).Range("AO" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO7").Copy 
    Sheets(DATABASE_SHEET).Range("AP" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO8").Copy 
    Sheets(DATABASE_SHEET).Range("AQ" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO9").Copy 
    Sheets(DATABASE_SHEET).Range("AR" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO10").Copy 
    Sheets(DATABASE_SHEET).Range("AS" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO11").Copy 
    Sheets(DATABASE_SHEET).Range("AT" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO12").Copy 
    Sheets(DATABASE_SHEET).Range("AU" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO13").Copy 
    Sheets(DATABASE_SHEET).Range("AV" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO14").Copy 
    Sheets(DATABASE_SHEET).Range("AW" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO15").Copy 
    Sheets(DATABASE_SHEET).Range("AX" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO16").Copy 
    Sheets(DATABASE_SHEET).Range("AY" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO17").Copy 
    Sheets(DATABASE_SHEET).Range("AZ" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO18").Copy 
    Sheets(DATABASE_SHEET).Range("BA" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO19").Copy 
    Sheets(DATABASE_SHEET).Range("BB" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO20").Copy 
    Sheets(DATABASE_SHEET).Range("BC" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO21").Copy 
    Sheets(DATABASE_SHEET).Range("BD" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO22").Copy 
    Sheets(DATABASE_SHEET).Range("BE" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO23").Copy 
    Sheets(DATABASE_SHEET).Range("BF" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO24").Copy 
    Sheets(DATABASE_SHEET).Range("BG" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYO25").Copy 
    Sheets(DATABASE_SHEET).Range("BH" & COUNT_ROW).PasteSpecial xlPasteValues 
     
    Range("QTYSUP1").Copy 
    Sheets(DATABASE_SHEET).Range("BI" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP2").Copy 
    Sheets(DATABASE_SHEET).Range("BJ" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP3").Copy 
    Sheets(DATABASE_SHEET).Range("BK" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP4").Copy 
    Sheets(DATABASE_SHEET).Range("BL" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP5").Copy 
    Sheets(DATABASE_SHEET).Range("BM" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP6").Copy 
    Sheets(DATABASE_SHEET).Range("BN" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP7").Copy 
    Sheets(DATABASE_SHEET).Range("BO" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP8").Copy 
    Sheets(DATABASE_SHEET).Range("BP" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP9").Copy 
    Sheets(DATABASE_SHEET).Range("BQ" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP10").Copy 
    Sheets(DATABASE_SHEET).Range("BR" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP11").Copy 
    Sheets(DATABASE_SHEET).Range("BS" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP12").Copy 
    Sheets(DATABASE_SHEET).Range("BT" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP13").Copy 
    Sheets(DATABASE_SHEET).Range("BU" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP14").Copy 
    Sheets(DATABASE_SHEET).Range("BV" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP15").Copy 
    Sheets(DATABASE_SHEET).Range("BW" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP16").Copy 
    Sheets(DATABASE_SHEET).Range("BX" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP17").Copy 
    Sheets(DATABASE_SHEET).Range("BY" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP18").Copy 
    Sheets(DATABASE_SHEET).Range("BZ" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP19").Copy 
    Sheets(DATABASE_SHEET).Range("CA" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP20").Copy 
    Sheets(DATABASE_SHEET).Range("CB" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP21").Copy 
    Sheets(DATABASE_SHEET).Range("CC" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP22").Copy 
    Sheets(DATABASE_SHEET).Range("CD" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP23").Copy 
    Sheets(DATABASE_SHEET).Range("CE" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP24").Copy 
    Sheets(DATABASE_SHEET).Range("CF" & COUNT_ROW).PasteSpecial xlPasteValues 
    Range("QTYSUP25").Copy 
    Sheets(DATABASE_SHEET).Range("CG" & COUNT_ROW).PasteSpecial xlPasteValues 
     
    Range("DATEADD").Copy 
    Sheets(DATABASE_SHEET).Range("CH" & COUNT_ROW).PasteSpecial xlPasteValues 
     
    Range("INVNUM").Copy 
    Sheets(DATABASE_SHEET).Range("A" & COUNT_ROW).PasteSpecial xlPasteValues 
     
    Range("B12:B36,G12:H36,I5").Select 
    Selection.ClearContents 
    Range("I5").Select 
     
     
    Application.ScreenUpdating = True 
     
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hi,

Within the VBA code I have written I am trying to do a Find "00/01/1900" and Replace "ONGOING" but it seems to be overlooking the request without returning any error messages. I need to change "00/01/1900" so I dont get large negative values in columns C and D.
I have other find and replace requests and they work fine.
Any help on this matter would be greatly appreciated.


	VB:
	
 
Sub MainMacro2() 
     '
     ' MainMacro2 Macro
     ' This one does everything!
     '
     'This looksup Property reference and brings back data in relevant cell
    Range("S3").Select 
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-13],Sheltered!C[-18],1,0)" 
    Range("T3").Select 
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-14],'Stocklist at 010410'!C[-19],1,0)" 
    Range("U3").Select 
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-15],'Minor Works'!C[-20],1,0)" 
    Range("V3").Select 
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-16],'Minor Works'!C[-21]:C[-17],5,0)" 
    Range("W3").Select 
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-17],'Minor Works'!C[-22]:C[1],24,0)" 
    Range("X3").Select 
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-18],'Major Works'!C[-23],1,0)" 
    Range("Y3").Select 
    ActiveCell.FormulaR1C1 = "=VLOOKUP('Major Works'!C[-24]:C[-20],5,0)" 
    Range("Y3").Select 
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-19],'Major Works'!C[-24]:C[-20],5,0)" 
    Range("Z3").Select 
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-20],'Major Works'!C[-25]:C[-2],24,0)" 
     
     'Copy and Paste Special Values on Selection
    Range("S3:Z3").Select 
    Selection.AutoFill Destination:=Range("S3:Z150"), Type:=xlFillDefault 
    Range("S3:Z150").Select 
    ActiveWindow.SmallScroll Down:=-126 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Application.CutCopyMode = False 
     
     'Find and Replace all 00/01/1900 dates with ONGOING
    Range("U3:Z150").Select 
    [COLOR=red]Selection.Replace What:="00/01/1900*", Replacement:="ONGOING", LookAt:= _[/COLOR] 
    [COLOR=red]                   xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _[/COLOR] 
    [COLOR=red]                   ReplaceFormat:=False[/COLOR] 
     
     
     'Add's formulas to Columns B,C,D to calculate Void Duration
    Range("B3").Select 
    ActiveCell.FormulaR1C1 = "=R1C6-RC[6]" 
    Range("C3").Select 
    ActiveCell.FormulaR1C1 = _ 
    "=IF(AND(RC[3]=RC[18],RC[20]=""ONGOING""),R1C6-RC[19],RC[20]-RC[19])" 
    Range("D3").Select 
    ActiveCell.FormulaR1C1 = _ 
    "=IF(AND(RC[2]=RC[20],RC[22]=""ONGOING""),R1C6-RC[21],RC[22]-RC[21])" 
     
     
     
     'Sets conditions for Columns B,C,D
    Range("B3").Select 
    Selection.FormatConditions.Delete 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=IF(B3>28,B3)" 
    Selection.FormatConditions(1).Interior.ColorIndex = 3 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=IF(AND(B3=14),B3)" 
    Selection.FormatConditions(2).Interior.ColorIndex = 44 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=IF(AND(B3>=0,B3=0,C314,C3)" 
    Selection.FormatConditions(3).Interior.ColorIndex = 3 
    Range("D3").Select 
    Selection.FormatConditions.Delete 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=IF(AND(D3=21),D3)" 
    Selection.FormatConditions(1).Interior.ColorIndex = 44 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=IF(AND(D3>=0,D328,D3)" 
    Selection.FormatConditions(3).Interior.ColorIndex = 3 
    Range("B3:D3").Select 
    Selection.AutoFill Destination:=Range("B3:D97"), Type:=xlFillDefault 
     
     
     'Copy and Paste Special Values in Columns B,C,D - CHANGE RANGE to match number of rows containing data
    Range("B3:D97").Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Application.CutCopyMode = False 
     
     'Replaces all #N/A values with ""
    Columns("B:Z").Select 
    Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
    Range("A1").Select 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hi all,

I am working on a workbook that has 2500 interview questions in it for specific managers in a company. Since it differs per region, the excel file generates (using VBA) a new file, sorted per manager with the applicable questions. Now; to calculate the score and make life easier. The newly generated file has a sheet with some buttons, one of which the calculate button. Since the sheet is copied from the main (lets call it; database file), the buttons are linked to the VBA scripts in this database. However; since the new file also includes these codes, I need the buttons to run the codes in the newly generated file.

To do so; I tried working a code in my new file generation VBA code. It worked once, and since some last tweaks, it does nothing. Comes up with a code 400 or other error. Could someone please help me?! Please find the code below.

(As I'm dutch, some references are in Dutch. Sure you will understand what is meant though! )


	VB:
	
 Bewaren() 
     'Working in Excel 2000-2010
    Dim fname As Variant 
    Dim NewWb As Workbook 
    Dim FileFormatValue As Long 
    Dim fact1 As String 
     
    Dim bestandsnaam As String 
    Dim cptype As String 
    Dim space As String 
     
    bestandsnaam = Sheets("Data_sheet_1").Range("C23").Text 
    cptype = Sheets("Data_sheet_1").Range("C24").Text 
    space = "_" 
     
    Application.ScreenUpdating = False 
     
    Blad3.Activate 
    Blad3.Cells.Select 
    Selection.Clear 
    Blad3.Columns("A:ZZ").Hidden = False 
    Blad3.Rows("1:34000").Hidden = False 
    Blad3.Columns("A:ZZ").ColumnWidth = 10 
     
    Blad3.Name = "Menu" 
     
    Blad55.Range("a1:k26").Copy 
    Blad3.Activate 
    Blad3.Range("a1").PasteSpecial xlPasteAll 
    Blad3.Columns("L:XFD").Hidden = True 
    Blad3.Rows("27:1048576").Hidden = True 
     
    Sheets("Output_Menu").Activate 
    ActiveSheet.Shapes.SelectAll 
    Selection.ShapeRange.Group.Name = "Group10" 
    Sheets("Output_Menu").Shapes("Group10").Copy 
    Application.Goto Sheets("Menu").Range("D7") 
    ActiveSheet.Paste 
     
    Blad55.Activate 
    ActiveSheet.Shapes.Range(Array("Group10")).Select 
    Selection.ShapeRange.Ungroup.Select 
     
    Blad3.Activate 
    ActiveSheet.Shapes.Range(Array("Group10")).Select 
    Selection.ShapeRange.Ungroup.Select 
    Selection.ShapeRange.IncrementLeft 18# 
     
    Blad1.Activate 
     
     'Check the Excel version
    If Val(Application.Version) < 9 Then Exit Sub 
    If Val(Application.Version) < 12 Then 
         
         'Only choice in the "Save as type" dropdown is Excel files(xls)
         'because the Excel version is 2000-2003
        fname = Application.GetSaveAsFilename(InitialFileName:="", _ 
        filefilter:="Excel Files (*.xls), *.xls", _ 
        Title:="This example copies the ActiveSheet to a new workbook") 
         
        If fname  False Then 
             'Copy the ActiveSheet to new workbook
            ActiveSheet.Copy 
            Set NewWb = ActiveWorkbook 
             
             'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False 
            NewWb.Close False 
            Set NewWb = Nothing 
             
        End If 
    Else 
         'Give the user the choice to save in 2000-2003 format or in one of the
         'new formats. Use the "Save as type" dropdown to make a choice,Default =
         'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
         
         
        fname = Application.GetSaveAsFilename(InitialFileName:=Format$(Date, "yyyy") & space & bestandsnaam & space & cptype,
filefilter:= _ 
        " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _ 
        " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _ 
        " Excel 2000-2003 Workbook (*.xls), *.xls," & _ 
        " Excel Binary Workbook (*.xlsb), *.xlsb", _ 
        FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook") 
         
         'Find the correct FileFormat that match the choice in the "Save as type" list
        If fname  False Then 
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1))) 
            Case "xls": FileFormatValue = 56 
            Case "xlsx": FileFormatValue = 51 
            Case "xlsm": FileFormatValue = 52 
            Case "xlsb": FileFormatValue = 50 
            Case Else: FileFormatValue = 0 
            End Select 
             
             'Now we can create/Save the file with the xlFileFormat parameter
             'value that match the file extension
            If FileFormatValue = 0 Then 
                MsgBox "Sorry, unknown file extension" 
            Else 
                 'Copies the ActiveSheet to new workbook
                Sheets(Array("Menu", "GM", "S&P", "ACC-TM", "HRM", "LM", "FOM", "Scores")).Select 
                Sheets(Array("Menu", "GM", "S&P", "ACC-TM", "HRM", "LM", "FOM", "Scores")).Copy 
                Set NewWb = ActiveWorkbook 
                 
                 'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _ 
                FileFormatValue, CreateBackup:=False 
                NewWb.Close False 
                Set NewWb = Nothing 
                 
            End If 
        End If 
    End If 
     
    Dim SourceFile As Workbook 
    Dim HomeBook As Workbook 
    Dim OtherBook As Workbook 
    Dim shp As Shape 
     
    SourceFile = ThisWorkbook.Name 
     
    HomeBook = ActiveWorkbook.Name 
    Workbooks.Open Filename:=SourceFile 
    OtherBook = SourceFile 
     
    Windows(OtherBook).Activate 
     
    For Each shp In Sheets("Menu").Shapes 
        If shp.Name = "printqrraudit" Then 
            Sheets("Menu").Shapes("printqrraudit").Select 
            Selection.OnAction = fact2 & ".xlsm!Blad3.qrraudit_printen" 
        ElseIf shp.Name = "GM" Then 
            Sheets("Menu").Shapes("GM").Select 
            Selection.OnAction = fact2 & ".xlsm!Blad3.reg_GM" 
        ElseIf shp.Name = "SP" Then 
            Sheets("Menu").Shapes("SP").Select 
            Selection.OnAction = fact2 & ".xlsm!Blad3.reg_SP" 
        ElseIf shp.Name = "ACC" Then 
            Sheets("Menu").Shapes("ACC").Select 
            Selection.OnAction = fact2 & ".xlsm!Blad3.reg_ACC" 
        ElseIf shp.Name = "HRM" Then 
            Sheets("Menu").Shapes("HRM").Select 
            Selection.OnAction = fact2 & ".xlsm!Blad3.reg_HRM" 
        ElseIf shp.Name = "LM" Then 
            Sheets("Menu").Shapes("LM").Select 
            Selection.OnAction = fact2 & ".xlsm!Blad3.reg_LM" 
        ElseIf shp.Name = "FOM" Then 
            Sheets("Menu").Shapes("FOM").Select 
            Selection.OnAction = fact2 & ".xlsm!Blad3.reg_FOM" 
        ElseIf shp.Name = "calc" Then 
            Sheets("Menu").Shapes("calc").Select 
            Selection.OnAction = fact2 & ".xlsm!Blad3.Standard_Score" 
        ElseIf shp.Name = "save" Then 
            Sheets("Menu").Shapes("save").Select 
            Selection.OnAction = fact2 & ".xlsm!Blad3.Bewaren" 
        ElseIf shp.Name = "prt" Then 
            Sheets("Menu").Shapes("prt").Select 
            Selection.OnAction = fact2 & ".xlsm!Blad3.results_printen" 
        End If 
    Next shp 
     
    Application.DisplayAlerts = False 
    ActiveWorkbook.Save 
    Workbooks(OtherBook).Close SaveChanges:=False 
    Application.DisplayAlerts = True 
     
    Windows(HomeBook).Activate 
     
    Sheets("Main_Screen").Select 
     
    Application.ScreenUpdating = True 
     
    Dim Answer As String 
    Dim MyNote As String 
    MyNote = "The file is generated, do you want to clear all entries?" 
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Tool opschonen?") 
    If Answer = vbNo Then 
        cancel = True 
    Else 
        Call clear_sheet 
         
        MsgBox ("All entries are deleted, the tool is ready to use.") 
         
    End If 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines

Sorry if things are not clear, but please try to help me if you can!

Thanks a lot.

I have searched all over for quite a few days for the answer to this, but to no avail. What I was hoping to be a simple Excel project for my company is almost done, and yet the following code to copy selected sheet values and formats only from a large Excel workbook heavy with macros to a new clean and lean workbook is still not working:


	VB:
	
 TransferSheets() 
     '
     ' TransferSheets Macro
     '
     ' Keyboard Shortcut: Ctrl+Shift+T
     '
    Application.ScreenUpdating = False 
    On Error Resume Next 
    Response = MsgBox("Do you want to copy the selected sheet(s) into a separate unlinked file to email/save?", vbYesNo +
vbCritical + vbDefaultButton1, "Transfer Sheets") 
    If Response = vbYes Then 
        Application.ActiveWorkbook.Windows(1).SelectedSheets.Copy 
        For Each wSheet In Worksheets 
            wSheet.Unprotect 
        Next wSheet 
        For Each ws In ActiveWorkbook.Worksheets 
            With ws.UsedRange 
                .Copy 
                .PasteSpecial xlValues 
            End With 
            Application.CutCopyMode = False 
            Application.Goto Reference:=ws.Range("A1") 
        Next ws 
        Dim nme As Name 
        For Each nme In ActiveWorkbook.Names 
            Debug.Print nme.Name, nme.RefersTo 
            If InStr(1, nme.RefersTo, "'[")  0 Then 
                nme.Delete 
            End If 
        Next 
    End If 
    Application.ScreenUpdating = True 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
The problem is when the above is copying a sheet that has VBA object code in it (ie Private Sub Worksheet_Change), I get a “Compile error: Sub or Function not defined” in the new workbook. As soon as the .PasteSpecial xlValues step is completed above, the next step jumps to the Private Sub Worksheet_Change code in the copied sheet of the new workbook. That code then tries to call another macro that doesn’t exist in the new workbook which ends with the compile error. Different sheets that have Private Sub Worksheet_Change call for different macros so I won't post their codes because the results are all the same: they are trying to call nonexistent macros in the new workbook.

The point of using the code above is to copy sheets without any extra code at all, including not copying the object codes in Sheet1 or Sheet2 or etc, and keep the new workbook small to give the results only to other colleagues. I have searched for ways to clean this code out but no luck, so any help on this would be greatly appreciated! I hope I have explained myself well enough with what I am trying to do here, but please do not hesitate to comment if you have any questions.

Hi – I’m really hoping someone can help me with some code to display data in the format I’m looking for. I’m still learning about vba code and I’ve been stuck trying to find a solution, as the ranges in my data will change from week to week.

I have attached my data sample here. I have a range of values in column H that will change in my future data samples, so the code has to be based on the number of unique values in this dynamic range. The values in column A are also unique, they are listed vertically to correspond with each unique value in column H.

MY DESIRED GOAL: I am trying to have the vertical data in columns A, H-J output horizontally based on my dynamic range in row H. I used a formula to calculate the number of unique values in column H, but I still need to figure out how to make the formula dynamic (the formula is located in cell L1).

I created an example of what I want the data to look like in the end, you can see this to the right of column L. I have a grid where the unique values from column H are listed across the top starting in cell O1. Underneath that, there are two horizontal rows for each value in column A, one row is hard-coded titled “weekend” and the second row is hard-coded titled “weekday”. I used two different colors in attempt to better illustrate. The data from columns I-J should output horizontally in this grid, starting in cell O2 in my example. Once the first two rows of data have been populated in the grid, the code needs to know to move down to begin the next loop (i.e. move to O4-O5 to work on the data for the next unique value in column A, which starts in row 22 in my sample). This needs to continue until all rows (i.e. in my sample there are 1121 rows of data, but the number of rows will be dynamic in future data) have been outputted into the grid. The biggest problem I have is that this data sample will change from week to week, the only thing constant is that I know what type of data will be in each column, but the number of unique values in column H will always change.

Note: it doesn’t matter to me if the final data is outputted on the same tab like I have it now, or if it’s on a new tab.

CODE: I don’t have much code at this point since I’m not quite sure from what angle to come at this with, I just have a few very basic samples that I have come up with so far. Here is some static code for getting the values for O2-O3 based on the values in I2 and J2; this is just a model to work off of to build out the grid I need, again I need to figure out how to make it dynamic:


	VB:
	
If Range("I2") = "No" Then 
    Range("O2").Value = "No" 
End If 
If Range("I2") = "No" And Range("J2") = "Yes" Then 
    Range("O3").Value = "Yes" 
End If 
If Range("I2") = "No" And Range("J2") = "No" Then 
    Range("O3").Value = "No" 
End If 
 
 'if it's a weekend event
If Range("I2") = "Yes" Then 
    Range("O3").Value = "No" 
End If 
If Range("I2") = "Yes" And Range("J2") = "Yes" Then 
    Range("O2").Value = "Yes" 
End If 
If Range("I2") = "Yes" And Range("J2") = "No" Then 
    Range("O2").Value = "No" 
End If 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines

I also have some code to transpose the number of unique values listed in column H to list them horizontally starting in O1, but my formula in L1 somehow needs to be modified to be dynamic.


	VB:
	
 
 
iNumEvents = Range("L1") + 1 
 
Range(Cells(2, 8), Cells(iNumEvents, 8)).Select 
Selection.Copy 
Range("O1").Select 
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
False, Transpose:=True 
Range("O1").Select 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Any help would be truly appreciated. This is my first time posting so please forgive anything I may have overlooked.

Hello

I have 7 worksheets within a workbook most of which have 20+ column headers. 1 of these worksheets is a summary of the other 6 sheets giving all records from every sheet but only the first 7 columns (this are the only columns common between sheets).

I have a macro to copy and paste all records into the summary sheet, however I have one problem, when there is no data input into a sheets I get an error. I looked into writing an if statement within VBA to return no values to the summary sheet when the first cell within a worksheet is blank, however I can't get this to work. Below is the original code which works if there is data entered into every form, this is before my attempt at the if statement. I hope this makes sense


	VB:
	
 Macro17() 
     
     'sheet 4 is my summary sheet and A3 is the first blank cell
    Sheets(4).Select 
    Rows("3:3").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    Range("A1").Select 
    Selection.End(xlDown).Offset(1, 0).Select 
    Sheets("Piping").Select 
    Range("B2:H2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 
    Sheets("Summary").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
     
    Range("A1").Select 
    Selection.End(xlDown).Offset(1, 0).Select 
    Sheets("Electrical").Select 
    Range("B2:H2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Summary").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
    Range("A1").Select 
    Selection.End(xlDown).Offset(1, 0).Select 
    Sheets("Instrumentation").Select 
    Range("B2:H2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Summary").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
    Range("A1").Select 
    Selection.End(xlDown).Offset(1, 0).Select 
    Sheets("Mechanical").Select 
    Range("B2:H2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Summary").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
     
    Range("A1").Select 
    Selection.End(xlDown).Offset(1, 0).Select 
    Sheets("Structural").Select 
    Range("B2:H2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Summary").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
    Range("A1").Select 
    Selection.End(xlDown).Offset(1, 0).Select 
    Sheets("Temporary").Select 
    Range("B2:H2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Summary").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines



No luck finding an answer? You could always try Google.