Email:      Pass:    Pass?
Close Window   
Free Ebook
Get Your Free Excel
ebook!
Our Top 15 Excel Tutorials
Instant Access!
E-mail:
Subscribe for Free Excel tips & more!
E-mail:


Advertisements


Free Excel Forum

Return To Previous Worksheet Macro

Forum Register
Search Excel Forum Posts, Tutorials, Macros, Tips, and More

Return to previous Excel worksheet
I have a workbook which I've designed to score submitted educational (veterinary) quizzes. Each worksheet holds a different quiz. When the quiz has been entered I want to copy person's name, details, score etc onto a new line on a "record" sheet. This works fine with the following code:

Sub DNut1()
' DNut1 Macro
Range("C2:H2").Select
Selection.Copy
Sheets("Record").Select
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

What I want to do is to insert a bit of code which takes you back to the previous page so the quiz can be retaken with a different name. I know I could do this by inserting the worksheet name but this would mean having a different macro for each quiz (worksheet). Is there any way of going back to the previous page regardless of its name?
I'm not really very familiar with VB code - I usually just search for it on the internet but have been unable to find this

Thanks
davroa

View Answers     

Similar Excel Video Tutorials

Helpful Excel Macros

Excel Macro that Searches Entire Workbook and Returns All Matches
- This is the ultimate Lookup Macro for Excel. It will search every worksheet in the workbook and return all of the mat
Vlookup Macro to Return All Matching Results and Stack them with Previous Results
- This is very similar to the other Vlookup type Macro in that it returns all of the results that match a particular se
Vlookup Macro to Return All Matching Results from a Sheet in Excel
- This Excel Macro works like a better Vlookup function because it returns ALL of the matching results. Run the
Delete Empty Columns
- This macro will delete columns which are completely empty. This means that if there is no data within the entire column
Combine Multiple Workbooks into One
- This macro for Microsoft Excel allows you to combine multiple workbooks and worksheets into one new workbook and workshe

Similar Topics







I have a workbook which I've designed to score submitted educational (veterinary) quizzes. Each worksheet holds a different quiz.
I would like to know whether it's possible to write a macro which would copy details from this excel sheet onto a certificate made up in Word. I would have to copy the text from about 4 or 5 cells across.
Could anyone help me with this - I'm not really familiar with VB scripting
Thanks
davroa


I wonder if someone can help me with this;

I have an excel document for marking (scoring) quizzes. There is one quiz per worksheet with check boxes. when submitted all the details of each quiz get copied to a different line of the "Record" worksheet. This all works fine.
The next stage is that I would like to copy from 5 cells of a single line of the "Records" sheet into 5 different text boxes in my template Word certificate. (1 -First Name, 2-Last Name, 3-Quiz title, 4-Date, 5-Score)(Then I would like to print this and go onto the next line in excel and repeat the procedure and so on.
From reading elsewhere in the forum I gather one thing I have to do is bookmark the textboxes in Word but I'm not sure what else I need to do
Would someone kindly instruct me on how to proceed (if indeed its possible to do what I've described.
Thank you in anticipation
davroa


xl 2003

I inherited a new job and the program tha goes with it. each week i have to re- enter 1500 values that are already on MY worksheet into a data entry (DE) worksheet, this sheet accepts only one entry ( employee name and one shift thay have worked) at a time and then this entry is submitted and appended to an ongoing (O) database from where it is accessed by other worksheets in the workbook ie GET PAYSLIPS .

i want to be able to copy paste MY worksheet data and thus append it to the (0) database without re-entering it all one by one into the DE worksheet


OR copy paste MY worksheet into the DE worksheet and send to (O) data base

THE PROBLEM
If i copy paste (special) into the O database from MY worksheet , the data is not recognised by the other worksheets in the workbook> it appears that it has to be sent from the DE worksheet

I am wondering if i am missing out some crucial entry by bypassing the TEDIOUS DATA ENTRY PAGE

NEXT 1500 ENTRIES DUE FRIDAY!!!

here are the programs

Sub AddNewEntryForSelectedEmployee()
' SaveJobData Macro
'


'check if saved before

Application.ScreenUpdating = False

'check that data exists
Range("v1").Select
If ActiveCell.Value = 0 Then
Range("b18").Select
Application.ScreenUpdating = True
MsgBox "No data is on the pay slip! Unable to save record"
GoTo endsub

End If


Range("k1").Select
If ActiveCell.Value = True Then ' true means already exists

Sheets("Job Database").Select
Range("A9").Select

Do

'error check first

ActiveCell.Offset(1, 0).Range("A1").Select
If ActiveCell.Value = "" Then

Application.ScreenUpdating = True

MsgBox "ERROR"
GoTo endsub
End If

'finds the matching record


Loop Until ActiveCell.Value = Range("n1").Value

Else ' else is that it is a new record

Sheets("Job Database").Select
Range("A9").Select

Do
ActiveCell.Offset(1, 0).Range("A1").Select

Loop Until ActiveCell.Value = ""

End If

'Copy SequenceID
Sheets("Job Entry").Select
Range("X1").Select
Selection.Copy
Sheets("Job Database").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copy Name
Sheets("Job Entry").Select
Range("D10").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Emp Code
Sheets("Job Entry").Select
Range("D12").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Age
Sheets("Job Entry").Select
Range("D13").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Date of Birth
Sheets("Job Entry").Select
Range("D14").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Work Location
Sheets("Job Entry").Select
Range("D18").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Week starting
Sheets("Job Entry").Select
Range("H4").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy JobDate
Sheets("Job Entry").Select
Range("B18").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'Copy Start Time
Sheets("Job Entry").Select
Range("e18").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'Copy Finish Time
Sheets("Job Entry").Select
Range("f18").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'Copy Public Holiday Flag
Sheets("Job Entry").Select
Range("c18").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'Copy Normal Time
Sheets("Job Entry").Select
Range("D21").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Shift Time
Sheets("Job Entry").Select
Range("D22").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Saturday Time
Sheets("Job Entry").Select
Range("D23").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Sunday Time
Sheets("Job Entry").Select
Range("D24").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy Public Holiday Time
Sheets("Job Entry").Select
Range("D25").Select
Selection.Copy
Sheets("Job Database").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Sheets("Job Entry").Select

Range("x2").Select
Selection.Copy
Range("x1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'go back to the top
Range("a1").Select


' Select cells b18 to f18 and clear the contents

'Checks for Employee Delete Flag
Range("L8").Select

If ActiveCell.Value = False Then
Range("D10").Select
Selection.ClearContents
End If

'Checks for Date Delete Flag
Range("L10").Select

If ActiveCell.Value = False Then
Range("B18").Select
Selection.ClearContents
End If

'Resets Public Holiday Flag to "N"
Range("C18").Select
ActiveCell.FormulaR1C1 = "N"

'Checks for Work Locations Delete Flag
Range("L12").Select

If ActiveCell.Value = False Then
Range("D18").Select
Selection.ClearContents
End If

'Checks for Start Time Delete Flag
Range("L14").Select

If ActiveCell.Value = False Then
Range("E18").Select
Selection.ClearContents
End If

'Checks for Finish Time Delete Flag
Range("L16").Select

If ActiveCell.Value = False Then
Range("F18").Select
Selection.ClearContents
End If


'go back to the first entry point

Range("B18").Select

MsgBox "Record Entered"

endsub:

Application.ScreenUpdating = True


End Sub




Sub GetPaySlipData()
'
' Copy In Job Details
'

'Delete old data first

Application.ScreenUpdating = False


Do

Range("A42").Select

If ActiveCell.Value "" Then

ActiveCell.Range("A1:H1").Select
Selection.Delete Shift:=xlUp

End If

Loop Until ActiveCell.Value = ""

'Find Matching Records
Range("A42").Select

Sheets("Job Database").Select
Range("b10").Select

Do

'check for name match
If ActiveCell.Value = Range("q2").Value Then
ActiveCell.Offset(0, 6).Range("A1").Select

'check for date match
If ActiveCell.Value >= Range("q3").Value Then
If ActiveCell.Value

Hi ,

I am new to VBA coding.and i want to reduce the length of the following recorded macro.
Can someone give me tips on how can i remove unnecessary data from following code or
replace lengthy coding with shorter code.I could not post whole code due to char length
restrictions




Code:

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 12/16/2009 by sameerk
'

'
    Dim numberOfRow
    Sheet1.Activate
    Selection.AutoFilter
    Range("Q1").AutoFilter Field:=17, Criteria1:=">0", Operator:=xlAnd
    Rows("1:1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    ActiveSheet.Paste
    Selection.End(xlUp).Select
    Rows("1:1").Select
    Application.CutCopyMode = False
    
    numberOfRow = InputBox("ENTER the number of row you want to take", "Number Of Debtors", 0)
       
    
    If (IsEmpty(numberOfRow) = True Or numberOfRow = 0) Then
        MsgBox "you have entered Wrong Number of row so Macro Stop the Proceeding", vbAbortRetryIgnore, "Warning FRom Macro"
        GoTo endmacro
    End If
    
    ActiveSheet.Previous.Select

    Rows("15:15").Select
    
    For i = 1 To numberOfRow
        Selection.Insert Shift:=xlDown
    Next
      ActiveSheet.Next.Select
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    ActiveSheet.Previous.Select
    Range("C15").PasteSpecial xlPasteValues
    Range("D15").Select
    ActiveSheet.Next.Select
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Previous.Select
    Range("D15").PasteSpecial xlPasteValues
    Range("E15").Select
    ActiveSheet.Next.Select
    Range("K2").Select
    Application.CutCopyMode = False
    Columns("K:K").Select
    Range("k2").Activate
    Selection.Insert Shift:=xlToRight
    ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
    Range("K2").Select
    Selection.Copy
    ActiveCell.Offset(0, -1).Select
    Range("J2").End(xlDown).Select
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Paste
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Selection.Copy
    ActiveSheet.Previous.Select
    Range("E15").Select
    ActiveSheet.Next.Select
    Range("R2").Select
    Application.CutCopyMode = False
    Columns("R:R").Select
    Range("R2").Activate
    Selection.Insert Shift:=xlToRight
    ActiveCell.FormulaR1C1 = "=RC[-3]+RC[-2]+RC[-1]"
    Range("R2").Copy
    Range("Q2").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Paste
    Selection.End(xlUp).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("K2").Select
    Range(Selection, Selection.End(xlDown)).Copy
    ActiveSheet.Previous.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F15").Select
    ActiveSheet.Next.Select
    Range("L2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Previous.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G15").Select
    ActiveSheet.Next.Select
    Range("M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Previous.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H15").Select
    ActiveSheet.Next.Select
    Range("N2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Previous.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I15").Select
    ActiveSheet.Next.Select
    Range("R2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Previous.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J15").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
    Range("J15").Select
    Selection.Copy
    Range("I15").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Paste
    Selection.End(xlUp).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Select
    'total
    Dim xtotal
    xtotal = "=SUM(J15:J" & numberOfRow + 14 & ")"
    ActiveCell.Value = xtotal
    
    'ActiveCell.FormulaR1C1 = xtotal
    
    Selection.Copy
    ActiveCell.Offset(0, -5).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(0, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("B15").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("B16").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Range("B16").Select
    Selection.Copy
    Range("C16").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -1).Select
    ActiveSheet.Paste
    Selection.End(xlUp).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    Selection.End(xlUp).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveCell.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("j:j").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("m:m").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("p:p").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("g15").Select
    ActiveCell.FormulaR1C1 = "=+IF(RC[-1]<0,""True"",""False"")"
    Selection.Copy
    Selection.Offset(0, -1).Select
    Selection.End(xlDown).Select
    Selection.Offset(-1, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.End(xlUp).Select
    Selection.Offset(0, 1).Select
    Range("g15").Select
    ActiveCell.Copy
    ActiveCell.Offset(0, 3).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveCell.Offset(0, -1).Select
    Selection.End(xlDown).Select
    Selection.Offset(-1, 1).Select
    ActiveSheet.Paste
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("j15").Select
    ActiveCell.Copy
    ActiveCell.Offset(0, 3).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveCell.Offset(0, -1).Select
    Selection.End(xlDown).Select
    Selection.Offset(-1, 1).Select
    ActiveSheet.Paste
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("m15").Select
    ActiveCell.Copy
    ActiveCell.Offset(0, 3).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveCell.Offset(0, -1).Select
    Selection.End(xlDown).Select
    Selection.Offset(-1, 1).Select
    ActiveSheet.Paste
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("h15").Select
    ActiveCell.FormulaR1C1 = "=+IF(RC[-1]=""True"",RC[-2],0)"
    Selection.Copy
    ActiveCell.Offset(0, -1).Select
    Selection.End(xlDown).Select
    Selection.Offset(0, 1).Select
    ActiveSheet.Paste
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("K15").Select
    ActiveCell.FormulaR1C1 = "=+IF(RC[-1]=""True"",RC[-2],0)"
    Selection.Copy
    ActiveCell.Offset(0, -1).Select
    Selection.End(xlDown).Select
    Selection.Offset(0, 1).Select
    ActiveSheet.Paste
    Range(Selection, Selection.End(xlUp)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
            Sheet1.Activate
    Selection.AutoFilter
    
    Sheet2.Activate
    Range("A1").Select
    
    Sheet3.Activate
    Range("A1:S" & numberOfRow + 14).Select
    Selection.ClearContents
    Range("A1").Select
    
        
    ActiveWorkbook.Save
    

   '
endmacro:
End Sub





Hello All,

I am here again with another problem. Since I am not a programer I don't have any idea on how to solve this one. So I am asking help from the Gurus. I have multiple sheets which have values in different columns and cells. I Have tried recording a macro and the code is below. But what I actually want something similar to the recorded macro to run on all the worksheet in a workbook and either put the results in a seprate workbook or worksheet. Here is the code that I generated using a recorded macro. I really appricate all of you for helping me out. Thank you all.

VB:

Sub M5_newsheet() 
     '
     ' M4_newsheet Macro
     ' Macro recorded 2009/08/11 by 859404154
     '
     
     '
    Sheets.Add 
    Sheets("Sheet1").Select 
    Range("A1:A2").Select 
    Selection.Copy 
    Sheets("Sheet14").Select 
    Range("A1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Sheets("Sheet1").Select 
    Range("F5:G5").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Sheet14").Select 
    Range("E1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
     
    Sheets("Sheet1").Select 
    Range("A605:A606").Select 
    Selection.Copy 
    Sheets("Sheet14").Select 
    Range("A3").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Sheets("Sheet1").Select 
    Range("F609:G609").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Sheet14").Select 
    Range("E3").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
    Sheets("Sheet1").Select 
    Range("A1208:A1209").Select 
    Selection.Copy 
    Sheets("Sheet14").Select 
    Range("A5").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Sheets("Sheet1").Select 
    Range("F1212:G1212").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Sheet14").Select 
    Range("E5").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
    Sheets("Sheet1").Select 
    Range("A1811:A1812").Select 
    Selection.Copy 
    Sheets("Sheet14").Select 
    Range("A7").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Sheets("Sheet1").Select 
    Range("F1815:G1815").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Sheet14").Select 
    Range("E7").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
    Sheets("Sheet1").Select 
    Range("A2413:A2414").Select 
    Selection.Copy 
    Sheets("Sheet14").Select 
    Range("A9").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Sheets("Sheet1").Select 
    Range("F2417:G2417").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Sheet14").Select 
    Range("E9").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
     
End Sub 


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




Hello, I am very new to writing macros and would really appreciate any help.

I have a spreadsheet full of names and addresses that are all contained within column A. Each record is of various length, anywhere from three rows to seven rows. The records are separated by a minimum of one blank cell, but often there are more than one blank cell between records. All in all, there are hundreds of records contained within thousands of rows.

I would like to copy and transpose each record and paste it into sheet2, with each record in its own row.

Here is the macro I've recorded, it starts at the top of the column and then finds the first record, transposes it, and then moves on to the second record. The macro transposes the first five records. Ideally, I'd like to figure out how to make the macro continue what it's doing until it reaches the end of the spreadsheet, when there are no more records to transpose. I've searched the internet trying to find an answer that would apply to my specific situation, but haven't had any luck. Any suggestions would be helpful. Thanks!

Sub Transpose()

Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveSheet.Next.Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
ActiveSheet.Previous.Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
ActiveSheet.Previous.Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
ActiveSheet.Previous.Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
ActiveSheet.Previous.Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Next.Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
ActiveSheet.Previous.Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
End Sub




I am trying to create a macro to copy and paste a range of cells from the previous sheet (i've been using ActiveSheet.Previous.Select) to the sheet that I ran the macro on only (I've been using ActiveSheet.Select). The active sheet is a copy of the previous sheet with a different name (names are Fri, Sat, Sun, etc. and are formatted exactly the same).

The ranges that I would like to copy is: M61:M84, N61:O84 (merged columns), P61:T84, and R85:R86 (merged rows)

Here is the code I currently have, but it is not working as I had hoped.

Sub copy_vessel_personnel()

'freezes screen
ScreenUpdating = False

' copy vessel personnel from prior sheet

ActiveSheet.Previous.Select
Range("M61:M84").Select
Selection.Copy
ActiveSheet.Select
Range("M61:M84").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Previous.Select
Range("N61:O84").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Select
Range("N61:O84").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Previous.Select
Range("P61:T84").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Select
Range("P61:T84").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Previous.Select
Range("R85:R86").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Select
Range("R85:R86").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub




Thanks,
Jordan

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:

Sub 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 me in support of injured Royal Marines






The following code is supposed to time a copy paste for me... and it works well... so well in fact it works across some of my other open spreadsheets and is mucking things up...

can someone advise me of what im doing wrong... I copied the following code and made adjustments based on my needs...

This code exists in the "This Workbook"

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.OnTime dTime, "MyMacro ()", , False

End Sub
Private Sub Workbook_Open()

Application.OnTime Now + TimeValue("00:05:00"), "MyMacro"

End Sub

This code is in a module


Public dTime As Date
Sub MyMacro()
dTime = Now + TimeValue("00:05:00")
Application.OnTime dTime, "MyMacro"

Range("A3").Select
Selection.Copy
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("B3").Select
Selection.Copy
Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("c3").Select
Selection.Copy
Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("d3").Select
Selection.Copy
Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("e3").Select
Selection.Copy
Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("f3").Select
Selection.Copy
Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("g3").Select
Selection.Copy
Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("h3").Select
Selection.Copy
Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("i3").Select
Selection.Copy
Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("j3").Select
Selection.Copy
Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("k3").Select
Selection.Copy
Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub


Thanks in advance for any suggestions


I have created a macro which is meant to collect certain datapoints from many difference sheets and paste it all into various places in two new sheets. However, when I had created the entire macro I got the following error message from Excel - "Compile Error - Procedure too large". Would you know anything I can do to avoid that error?

Alternatively...do you know how to make my macro shorter. Please see macro below...I have only pasted the copy iterations for three of the spreadsheets (they are separated by some space in between). However, in reality, this is in fact 94 copy iterations.

Sheets("Test1").Select
Range("A47:A70").Select
Selection.Copy
Sheets("Top Companies_NAV").Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Top Companies_Cash Flows").Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test1").Select
Range("D47:D70").Select
Selection.Copy
Sheets("Top Companies_NAV").Select
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test1").Select
Range("E47:E70").Select
Selection.Copy
Sheets("Top Companies_NAV").Select
Range("E7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test1").Select
Range("G47:G70").Select
Selection.Copy
Sheets("Top Companies_Cash Flows").Select
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Sheets("Test2").Select
Range("A47:A70").Select
Selection.Copy
Sheets("Top Companies_NAV").Select
Range("A31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Top Companies_Cash Flows").Select
Range("A31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test2").Select
Range("D47:D70").Select
Selection.Copy
Sheets("Top Companies_NAV").Select
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test2").Select
Range("E47:E70").Select
Selection.Copy
Sheets("Top Companies_NAV").Select
Range("E31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test2").Select
Range("G47:G70").Select
Selection.Copy
Sheets("Top Companies_Cash Flows").Select
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Sheets("Test3").Select
Range("A47:A70").Select
Selection.Copy
Sheets("Top Companies_NAV").Select
Range("A55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Top Companies_Cash Flows").Select
Range("A55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test3").Select
Range("D47:D70").Select
Selection.Copy
Sheets("Top Companies_NAV").Select
Range("B55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test3").Select
Range("E47:E70").Select
Selection.Copy
Sheets("Top Companies_NAV").Select
Range("E55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test3").Select
Range("G47:G70").Select
Selection.Copy
Sheets("Top Companies_Cash Flows").Select
Range("B55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False




Any help is very much appreciated. Thank you very much!

Kind regards,

Mikael Jast


So I'm pretty good with Excel, and in the past 3 months I've started trying to "self-teach" myself how to write macros. I began by just recording certain actions and seeing what the code looked like etc.

Any way I have a shared workbook that is about 10MB in size and has close to 100 worksheets. First, I have macros in almost all of them that refresh based on the category that was selected in the summary worksheet for each site. They are activated by button clicks. My question is I have all these recorded in the workbook and they are all the same, but I had to record them all individually because the worksheet names are all different. (Example of the code is below)

Sub Button35thCap_Click()
'
' Button35thCap_Click Macro
' Macro recorded 2/20/2009 by mjsulli1
'

'
Selection.AutoFilter Field:=3, Criteria1:="Capacity"
Columns("C:C").Select
Selection.EntireColumn.Hidden = True
End Sub

Is there any way to make a macro that can be used for each button instead of having to have 60 different ones? The workbook is already slow due to being on a server in one part of the country and people working in the file from all over. If I could eliminate some of the macros it would speed up the workbook.


Second question:
In the same workbook I have a macro that copies the 18 summary sheets into one Master Data worksheet. I again just recorded this by copying and paste special valuing the sheets into the master worksheet. I know there has to be a more effective way to do this. I feel like this macro is setup to fail me. Also, if someone inserts a row, the addition won't be grabbed by the macro and it will be difficult to quickly update the macro. The code is listed below.

Sheets("IA Reg").Select
Range("B11:AJ95").Select
Selection.Copy
Sheets("MasterData").Select
Range("A8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A93").Select
Sheets("Portland").Select
Range("B11:AJ120").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A203").Select
Sheets("Irvine").Select
Range("B11:AJ81").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A274").Select
Sheets("Mexicali").Select
Range("B11:AJ103").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A367").Select
Sheets("Melbourne").Select
Range("B11:AJ103").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A460").Select
Sheets("Richardson").Select
Range("B11:AJ68").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A518").Select
Sheets("C-Ave").Select
Range("B11:AJ194").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A702").Select
Sheets("Coralville").Select
Range("B11:AJ73").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A765").Select
Sheets("San Jose").Select
Range("B11:AJ63").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A818").Select
Sheets("STS").Select
Range("B11:AJ83").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A891").Select
Sheets("35th St").Select
Range("B11:AJ47").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A928").Select
Sheets("Carlsbad").Select
Range("B11:AJ74").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A992").Select
Sheets("M&S").Select
Range("B11:AJ67").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1049").Select
Sheets("AMT").Select
Range("B11:AJ43").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1082").Select
Sheets("CPC").Select
Range("B11:AJ54").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1126").Select
Sheets("ETES").Select
Range("B11:AJ69").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1185").Select
Sheets("FAB").Select
Range("B11:AJ58").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1233").Select
Sheets("Facilities").Select
Range("B11:AJ144").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1367").Select
Sheets("RCD").Select
Range("B11:AJ120").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Up:=1366
End Sub

Once again, I'm definitely a beginner with macros, but I'm slowly but surely adding it to my repertoire. Any advice or guidance would be appreciated.

Thanks,

Mike



Hi guys,
I have a macro which copies various cells, and then pastes these cells onto the end of some columns (see code below).
The macro works fine, but I want to include some error catching, and I am not sure how to do this.
Basically, I want the macro to warn the user with "All data being pasted is the same as previous weeks - are you sure you wish to continue?" with a yes/no button, if ALL the data being pasted into empty cells matches the cells above.
(Some of the data may me the same, but it can't all be).
Any ideas would be great, thanks!


Sub Test()
Sheets("summary page").Select
Range("F6").Select
Selection.Copy
Range("s9").Select
Do While Not IsEmpty(ActiveCell.Offset(0, 0))
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("summary page").Select
Range("X54:X56").Select
Selection.Copy
Range("z8").Select
Do While Not IsEmpty(ActiveCell.Offset(0, 0))
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("summary page").Select
Range("G11").Select
Selection.Copy
Range("U86").Select
Do While Not IsEmpty(ActiveCell.Offset(0, 0))
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("summary page").Select
Range("G18").Select
Selection.Copy
Range("T86").Select
Do While Not IsEmpty(ActiveCell.Offset(0, 0))
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub


hello everyone,

I wanted to thank everyone ahead of time for help with this one as I have been racking my brain trying to get this done.

What I am trying to do is basically copy and paste certain cells in certain rows to a worksheet where it will be placed in defined areas on that worksheet. It will then copy that worksheet and do the same thing to the newly created worksheet. Currently, the code I created is in a loop and stops with an error 1004 in Excel 2003. However, when I have used the same macro in excel 2007 it works fine but really slow when the number of sheets created reaches about 200 or so. I have copied my code in here for you to review and maybe someone can help me out with it. Thanks again.

Code:

Sub CREAT()

Dim WS As Worksheet, WB As Workbook
    Set WB = ActiveWorkbook
    Set WS = WB.Sheets("Auto ID card")


Application.ScreenUpdating = False
 Sheets("Main").Select
 Range("b14").Select
 Selection.Copy
 Worksheets(Worksheets.Count).Activate
Range("b11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Main").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Worksheets(Worksheets.Count).Activate
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Main").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Worksheets(Worksheets.Count).Activate
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Main").Select
ActiveCell.Offset(0, 2).Select
Selection.Copy
Worksheets(Worksheets.Count).Activate
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
WS.Copy After:=Sheets(WB.Sheets.Count)
Application.CutCopyMode = False
  
 Do
Sheets("Main").Select
ActiveCell.Offset(1, -4).Select
Selection.Copy
Worksheets(Worksheets.Count).Activate
Range("b11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Main").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Worksheets(Worksheets.Count).Activate
Range("d11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Main").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Worksheets(Worksheets.Count).Activate
Range("f11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Main").Select
ActiveCell.Offset(0, 2).Select
Selection.Copy
Worksheets(Worksheets.Count).Activate
Range("h11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
WS.Copy After:=Sheets(WB.Sheets.Count)
Sheets("Main").Select
Application.CutCopyMode = False

Loop Until IsEmpty(ActiveCell.Offset(1, 0))

Worksheets(Worksheets.Count).Activate
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

Sheets("Main").Select
Application.CutCopyMode = True

Application.ScreenUpdating = True




End Sub





I have a macro that copies data from 6 different worksheets into one summary worksheet - based on certain criteria - I need a way to note on each row of the summary sheet which worksheet it was copied from. Each worksheet is specific to a salesperson, so ideally I would like that salespersons last name to populate in column on the summary page for each line of theirs that is copied over....here is my current macro I use to copy the data: (this scrpit is repeated for each sales persons sheet - "Blankenship", "Dew", etc...)

Code:

Sheets("Bailey").Select
    Range("B29").Select
    Set r = Range("B29:B153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Award") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
    
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Pending") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Bid") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Lead") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Lost") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    Range("B29").Select
    
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Follow-up") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    Range("B29").Select


Any help would be greatly appreciated!


I have a macro that copies data from 6 different worksheets into one summary worksheet - based on certain criteria - I need a way to note on each row of the summary sheet which worksheet it was copied from. Each worksheet is specific to a salesperson, so ideally I would like that salespersons last name to populate in column on the summary page for each line of theirs that is copied over....here is my current macro I use to copy the data: (this scrpit is repeated for each sales persons sheet - "Blankenship", "Dew", etc...)

Code:

Sheets("Bailey").Select
    Range("B29").Select
    Set r = Range("B29:B153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Award") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
    
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Pending") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Bid") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Lead") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Lost") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    Range("B29").Select
    
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Follow-up") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    Range("B29").Select


Any help would be greatly appreciated!


i need help with this setting this vba right

i have two sheets in my workbook
-data
-voucher

im trying to write a macro that will copy data from sheet(voucher) to sheet(data)

the data will be entered in different rows & colums in the sheets(voucher)
the macro has to copy data from the different cells on sheet(voucher) spread over different colums & rows & paste the same on a single row on sheet(data),
then erase the information on sheet(voucher), so the sheet(voucher) is ready for a new entry.

the challenge lies in finding the last cell on sheet(data) everytime & then pasting the data from sheet(voucher)

what is happening is that the coppy paste & then erase is working fine, the problem is it keeps overwritting the same row in sheet(data), is there any way
that it would copy paste to the last row in sheet(data)


this is what the macro stands at for now


Sub copy_paste()
'
' copy_paste Macro
' Macro recorded 25/04/2009
'
'
Application.ScreenUpdating = False
Sheets("data").Select
Range("A65536").End(xlUp).Offset(1, 0).Select

Range("B4:C4").Select
Selection.Copy
Sheets("data").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Voucher").Select
Range("F4:G4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("data").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Voucher").Select
Range("E6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("data").Select
Sheets("data").Name = "data"
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Voucher").Select
Range("B8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("data").Select
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Voucher").Select
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("data").Select
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Voucher").Select
Range("G8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("data").Select
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Voucher").Select
Range("B13:G13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("data").Select
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Voucher").Select
Range("C10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("data").Select
ActiveWindow.SmallScroll ToRight:=8
Range("O2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Voucher").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("B8").Select
Selection.ClearContents
Range("E8").Select
Selection.ClearContents
Range("E6").Select
Selection.ClearContents
Range("G8").Select
Selection.ClearContents
Range("F4:G4").Select
Range("G4").Activate
Selection.ClearContents
Range("B4:C4").Select
Selection.ClearContents
Range("B13:G13").Select
Selection.ClearContents
Range("F4").Select
Application.ScreenUpdating = True
End Sub


thanx in advance

i have spent the whole night figuring out.....im siging off for now


Hi was writing a VB for a commandButton that I could click that perform Copy and Paste.

But I get an Error of Runtime Error"1004", applicaition define or Range Define Error.

The Range I am pointing to is at another sheet in the same workbook.

I can run this without error if i'm not using a Command Button.

Here is my code:

Private Sub CommandButton2_Click()

If (Range("Current_Period") = 1) Then

Sheets("Page 1.0").Select
Range("C5:H14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D19").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 2) Then

Sheets("Page 1.0").Select
Range("C5:H14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D29").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 3) Then

Sheets("Page 1.0").Select
Range("C5:H14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D39").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 4) Then

Sheets("Page 1.0").Select
Range("C5:H14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D49").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 5) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D59").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 6) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D69").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


ElseIf (Range("Current_Period") = 7) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D79").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


ElseIf (Range("Current_Period") = 8) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D89").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


ElseIf (Range("Current_Period") = 9) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D99").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 10) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D109").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 11) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D119").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 12) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D129").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

End If

End Sub

Private Sub UpdateYTD_Click()

'
' UpdateYTDFD Macro
' Macro recorded 27/11/2006 by AUKwokTi
'

'Copy the monthly figures into the YTD Sheet for fixed Distribution

'

If (Range("Current_Period") = 1) Then

Sheets("Page 1.0").Select
Range("C5:H14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D19").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 2) Then

Sheets("Page 1.0").Select
Range("C5:H14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D29").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 3) Then

Sheets("Page 1.0").Select
Range("C5:H14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D39").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 4) Then

Sheets("Page 1.0").Select
Range("C5:H14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D49").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 5) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D59").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 6) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D69").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


ElseIf (Range("Current_Period") = 7) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D79").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


ElseIf (Range("Current_Period") = 8) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D89").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


ElseIf (Range("Current_Period") = 9) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D99").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 10) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D109").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 11) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D119").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

ElseIf (Range("Current_Period") = 12) Then

Sheets("Page 1.0").Select
Range("C5:J14").Select
Selection.Copy
Sheets("Page 10.0").Select
Range("D129").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

End If


'
End Sub

I don't know what i have done wrong,please help.!!


I have a macro that copies data from 6 different worksheets into one summary worksheet - based on certain criteria - I need a way to note on each row of the summary sheet which worksheet it was copied from. Each worksheet is specific to a salesperson, so ideally I would like that salespersons last name to populate in column B on the summary page for each row of theirs that is copied over....here is my current macro I use to copy the data: (this code is repeated for each sales persons sheet - "Blankenship", "Dew", etc...) I have attached a scaled down version of my file.

Code:

Sub SumData()
'
' SummarizeData from Sales Sheets
'
    Sheets("Bailey").Select
    Range("B29").Select
    Set r = Range("B29:B153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Award") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
    
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Pending") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Bid") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Lead") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    
    Range("B29").Select
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Lost") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    Range("B29").Select
    
    Set r = Range("B29:C153")
    For n = 1 To r.Rows.Count
    myval = ActiveCell.Value
    
    If InStr(myval, "Follow-up") > 0 Then
        ActiveCell.Range("A1:N1").Select
        Selection.Copy
    Sheets("Summary").Select
    NextRow = Range("A65536").End(xlUp).Row + 1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Select
    End If
    Sheets("Bailey").Select
        
    ActiveCell.Offset(1, 0).Select
    Next n
    Range("B29").Select


Any help will be greatly appreciated!


Hi I am new to vba stuff just wondering if maybe using an array somehow if I can get the following code in a 16x loop Code:

'stats 1

    If ActiveSheet.Name = "Stats1" Then
    
        Sheets("Stats Page").Select
  
        Range("C3").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats1").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("G3").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
    End If
    
'stats 2
    
    If ActiveSheet.Name = "Stats2" Then
    
    Sheets("Stats Page").Select
    
    Range("L3").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats2").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("P3").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
    
 'stats 3
    
    If ActiveSheet.Name = "Stats3" Then
    
    Sheets("Stats Page").Select
    
    Range("U3").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats3").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("Y3").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
    
'stats 4

    If ActiveSheet.Name = "Stats4" Then
    
        Sheets("Stats Page").Select
  
        Range("C11").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats4").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("G11").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
    End If
    
'stats 5
    
    If ActiveSheet.Name = "Stats5" Then
    
    Sheets("Stats Page").Select
    
    Range("L11").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats5").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("P11").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
    
 'stats 6
    
    If ActiveSheet.Name = "Stats6" Then
    
    Sheets("Stats Page").Select
    
    Range("U11").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats6").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("Y11").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
    
'stats 7

    If ActiveSheet.Name = "Stats7" Then
    
        Sheets("Stats Page").Select
  
        Range("C19").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats7").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("G19").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
    End If
    
'stats 8
    
    If ActiveSheet.Name = "Stats8" Then
    
    Sheets("Stats Page").Select
    
    Range("L19").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats8").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("P19").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
    
 'stats 9
    
    If ActiveSheet.Name = "Stats9" Then
    
    Sheets("Stats Page").Select
    
    Range("U19").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats9").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("Y19").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
    
'stats 10

    If ActiveSheet.Name = "Stats10" Then
    
        Sheets("Stats Page").Select
  
        Range("C27").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats10").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("G27").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
    End If
    
'stats 11
    
    If ActiveSheet.Name = "Stats11" Then
    
    Sheets("Stats Page").Select
    
    Range("L27").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats11").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("P27").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
    
 'stats 12
    
    If ActiveSheet.Name = "Stats12" Then
    
    Sheets("Stats Page").Select
    
    Range("U27").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats12").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("Y27").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
    
'stats 13

    If ActiveSheet.Name = "Stats13" Then
    
        Sheets("Stats Page").Select
  
        Range("C35").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats13").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("G35").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
    End If
    
'stats 14
    
    If ActiveSheet.Name = "Stats14" Then
    
    Sheets("Stats Page").Select
    
    Range("L35").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats14").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("P35").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
    
 'stats 15
    
    If ActiveSheet.Name = "Stats15" Then
    
    Sheets("Stats Page").Select
    
    Range("U35").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats15").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("Y35").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    
    End If
    
 'stats 16
    
    If ActiveSheet.Name = "Stats16" Then
    
    Sheets("Stats Page").Select
    
    Range("U43").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        
        Sheets("Stats16").Select
        Range("K1:L4").Select
    Selection.Copy
    
    Sheets("Stats Page").Select
        
        Range("Y43").Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    
    End If





Hi all,

I've written some code that breaks up a large spreadsheet into 5 smaller ones by copying the the sheets based on the sheet tab names and copies and pastes as values.

I want to add the "Summary" sheet to each of the 5 new spreadsheets that were created, but I can't figure out how to do it.

The Debugger stop at this line in the code.
Sheets("Summary").Copy Befo =Workbooks(LJS).Sheets(1)

Any Ideas?


Here is my code:

Sub Copy()
Dim LJS As Workbook, ws As Worksheet, ss As Worksheet, AW As Workbook, PH As Workbook, TB As Workbook, KFC As Workbook
For Each ws In ThisWorkbook.Worksheets
If Left(ws.Name, 1) = "A" Or Left(ws.Name, 1) = "B" Or Left(ws.Name, 1) = "G" Or ws.Name = "Summary" Then
If Left(ws.Name, 6) "A55677" And Left(ws.Name, 6) "B29187" And Left(ws.Name, 6) "A55678" Then


If Right(ws.Name, 3) = "LJS" Then
If LJS Is Nothing Then
ws.Copy
Set LJS = ActiveWorkbook

Else
ws.Copy after:=ss

End If
End If


If Right(ws.Name, 3) = "A&W" Then
If AW Is Nothing Then
ws.Copy
Set AW = ActiveWorkbook

Else
ws.Copy after:=ss

End If
End If


If Right(ws.Name, 2) = "PH" Then
If PH Is Nothing Then
ws.Copy
Set PH = ActiveWorkbook

Else
ws.Copy after:=ss

End If
End If



If Right(ws.Name, 2) = "TB" Then
If TB Is Nothing Then
ws.Copy
Set TB = ActiveWorkbook

Else
ws.Copy after:=ss

End If
End If


If Right(ws.Name, 3) = "KFC" Then
If KFC Is Nothing Then
ws.Copy
Set KFC = ActiveWorkbook

Else
ws.Copy after:=ss

End If
End If


Range("H2").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("H2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("F6000").End(xlUp).Copy
Range("F6000").End(xlUp).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("E10:E60").Copy
Range("E10:E60").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("A1").Select

Range("B10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Cells.Select
Selection.ClearComments
Range("A1").Select

Set ss = ActiveSheet
End If
End If
Next ws

'This part is not working


Activate.ThisWorkbook

Sheets("Summary").Copy Befo =Workbooks(LJS).Sheets(1)


Range("H1:H200").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("L1:L200").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("A1").Select

Activate.ThisWorkbook

End Sub


Hi There

I am nearly there but need your assistance I have a deadline of 12pm and am running out of ideas!!!

I am trying to define the macro entitled "interest" so that it only operates on the work sheet "cash flow monthly" i.e. an input can be made on other worksheets which enables the macro but the macro ONLY runs on the worksheet "cash flow monthly"

Also I am trying to ensure that the cursor moves back to where the ammendement was made i.e. if the cell ammendement was made in cell A1 the macro should run but the cursor should remain in cell A1.

Your help would be much appericated

Thanks





Sub Workbook_Open()

'Run Macro

ThisWorkbook.Worksheets("Cash Flow monthly").OnEntry = "interest"
ThisWorkbook.Worksheets("P&L Monthly").OnEntry = "interest"
ThisWorkbook.Worksheets("Balance Sheet").OnEntry = "interest"
ThisWorkbook.Worksheets("Nominal Revenue Comparison").OnEntry = "interest"

End Sub

Sub interest()
'
' interest Macro

Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B29").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub


I have writen a macro to help me in work to keep track of my guys by having them fill in a simple form in excel which I can then copy across to various worksheets.....but I keep getting a error 1004 message.

If anyone can spot my mistake I'd be very grateful

Quote:

' Keyboard Shortcut: Ctrl+q
'
Range("A3:C3").Select
Selection.Copy

Sheets("Licences").Select
Range("A2").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("Contact Details").Select
Range("A1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("Courses").Select
Range("A1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("A67:C67").Select
Sheets("Manning").Select
Range("A5").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("REPORTS").Select
Range("A1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MASTER").Select
Range("A9:B9").Select
Application.CutCopyMode = False
Selection.Copy

Sheets("Manning").Select
Range("A5").Select
Selection.End(xlDown).Offset(0, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MASTER").Select
Range("A18:D18").Select
Application.CutCopyMode = False
Selection.Copy

Sheets("Contact Details").Select
Range("A1").Select
Selection.End(xlDown).Offset(0, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MASTER").Select
Range("E18:F18").Select
Application.CutCopyMode = False
Selection.Copy

Sheets("Contact Details").Select
Range("A1").Select
Selection.End(xlDown).Offset(0, 4).Select
Application.CutCopyMode = False
Selection.Copy

Sheets("MASTER").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Contact Details").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MASTER").Select
Range("G18:H18").Select
Application.CutCopyMode = False
Selection.Copy

Sheets("Contact Details").Select
Range("A1").Select
Selection.End(xlDown).Offset(0, 5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MASTER").Select
Range("A30:C30").Select
Application.CutCopyMode = False
Selection.Copy

Sheets("REPORTS").Select
Range("A1").Select
Selection.End(xlDown).Offset(0, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MASTER").Select
Range("L3:X3").Select
Application.CutCopyMode = False
Selection.Copy

Sheets("Courses").Select
Range("A1").Select
Selection.End(xlDown).Offset(0, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MASTER").Select
Range("J8:X8").Select
Application.CutCopyMode = False
Selection.Copy

Sheets("Licences").Select
Range("A1").Select
Selection.End(xlDown).Offset(0, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MASTER").Select
Range("J11:X11").Select
Application.CutCopyMode = False
Selection.Copy

Sheets("Licences").Select
Range("A1").Select
Selection.End(xlDown).Offset(0, 19).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub




Scenario ....

I have data in a worksheet that is filtered to one row using the AutoFilter. The filtered row is presented on the 2nd row of the worksheet, but the data is represented as row 15. (the actual data record is on row 15, the filter displays it on row 2 and labelled in blue as 15)

I have code designed to copy (overwrite) a one row range of cells to the exposed row of data on the filtered worksheet. I used record macro to write the code.

But in the code, the paste reference is for row 15, not row 2. Since the filtered list will be dynamic (not always row 15), what do I need to do to have pasting always done on the 2nd row of the filtered sheet regardless of the record # (actual row filtered)?

I don't think I can use an advanced filter without losing continuity with other code in my project.

Code:

 
 
    ' copy cells D6-X6 from worksheet TARGET (static) 
    Sheets("Target").Select
    Range("D6:X6").Select
    Selection.Copy
    ' paste cells to 2nd row of filtered worksheet GROUP_DATA (dynamic) 
    Sheets("Group_Data").Select
    Range("D15").Select  '** problem:: this will always apply the paste to record 15, not whatever record filtered and displayed in row position 2 of the worksheet.  
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Y15").Select
    Sheets("Target").Select
    Range("Y6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Group_Data").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter


Jenn


Hi all
This probably very easy to do but I can't figure out how.

I have a macro that unprotects a worksheet copies data from that worksheet and pastes it into a newly created and saved workbook. However I have two problems

1) I'm attempting to copy the data from the first workbook by selecting all cells and then when switching to the new workbook, select all cells and the paste special (values) then paste special (formats). This works when recording the macro but when I attempt to run it it bombs out.

Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False



2) How do I get the macro to switch back to the workbook it got its data from. The name of the source workbook varies and there may be from 2 to 15 workbooks open. Is there a previous active workbook command? or do I need to create some kkind of temporary value to hold the file name of the source workbook.


Regards
John


Hi there

I have created the two below macros by using the record function and my limited knowledge of writing macros.

I have two issues that i would lik som e help with:

1) can these macros be written in a more simpel way?

2) The second macro ends of by applying a protection to the sheet, but it doesnt seem to add a password to the protection. I would like for the password to be: wfm

Any help is very much appreciated thank you

KB

Code:

Sub copy1()


Application.ScreenUpdating = False

Sheets("Current Baseline").Select
    Range("h5:h11").Copy '
Sheets("SMO Current Baseline Plan Acc").Select
    Range("r5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sheets("Current Baseline").Select
    Range("k5:k11").Copy '
Sheets("SMO Current Baseline Plan Acc").Select
    Range("z5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sheets("Current Baseline").Select
    Range("n5:n11").Copy '
Sheets("SMO Current Baseline Plan Acc").Select
    Range("ah5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sheets("Current Baseline").Select
    Range("q5:q11").Copy '
Sheets("SMO Current Baseline Plan Acc").Select
    Range("ap5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sheets("Current Baseline").Select
    Range("t5:t11").Copy '
Sheets("SMO Current Baseline Plan Acc").Select
    Range("ax5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("w5:w11").Copy
Sheets("SMO Current Baseline Plan Acc").Select
    Range("bf5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("z5:z11").Copy
Sheets("SMO Current Baseline Plan Acc").Select
    Range("bn5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("ac5:ac11").Copy
Sheets("SMO Current Baseline Plan Acc").Select
    Range("bv5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("af5:af11").Copy
Sheets("SMO Current Baseline Plan Acc").Select
    Range("cd5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("ai5:ai11").Copy '
Sheets("SMO Current Baseline Plan Acc").Select
    Range("cl5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("al5:al11").Copy '
Sheets("SMO Current Baseline Plan Acc").Select
    Range("ct5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("ao5:ao11").Copy '
Sheets("SMO Current Baseline Plan Acc").Select
    Range("db5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("h19:h25").Copy '
Sheets("SMO Current Baseline Plan Dept").Select
    Range("r5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("k19:k25").Copy '
Sheets("SMO Current Baseline Plan Dept").Select
    Range("z5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("n19:n25").Copy '
Sheets("SMO Current Baseline Plan Dept").Select
    Range("ah5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("q19:q25").Copy '
Sheets("SMO Current Baseline Plan Dept").Select
    Range("ap5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("t19:t25").Copy
Sheets("SMO Current Baseline Plan Dept").Select
    Range("ax5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Current Baseline").Select
    Range("w19:w25").Copy
Sheets("SMO Current Baseline Plan Dept").Select
    Range("bf5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Application.ScreenUpdating = True

End Sub



Code:

Application.ScreenUpdating = False

    ActiveSheet.Unprotect
    Sheets("SMO Current Q Plan Acc").Select
    Range("E6:G16").Select
    Selection.Copy
    Sheets("Overview SMO").Select
    Range("E20").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("SMO Current Q Plan Acc").Select
    Range("E19:G27").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Overview SMO").Select
    Range("E33").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Application.ScreenUpdating = True