|
Return To Previous Worksheet Macro
|
|
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
Similar Excel Video Tutorials
VLOOKUP & Previous Bracket Trick
- See how to use the DOLLAR, VLOOKUP, INDEX and MATCH function and a Previous Bracket Commission Formula Trick to calculate total commissions when you h ...
Helpful Excel Macros
Delete Empty Columns
- This macro will delete columns which are completely empty. This means that if there is no data within the entire column
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
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
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
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 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
I have struggled for a day now searching and tweaking but I cannot figure this out.
Worksheet (Daily Sales) - daily input, copy to the worksheet (Weekly Sales), Monday through Saturday. The ranges copied are not consecutive. I am using If...then...else.
Code:
If Range("G3") = "Monday " Then
Range("G3").Select
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("C3").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C5:C13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("C4").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C3:C4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("C14").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("C16").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C15:C17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("C22").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C19:C22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("C25").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C34").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("C19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If Range("G3") = "Tuesday" Then
Range("G3").Select
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("D3").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("c5:c13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("d4").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C3:C4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("d14").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("d16").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C15:C17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("d22").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C19:C22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("d25").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C34").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("d19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If Range("G3") = "Wednesday" Then
Range("G3").Select
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("e3").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("c5:c13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("e4").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C3:C4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("e14").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("e16").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C15:C17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("e22").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C19:C22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("e25").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C34").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("e19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If Range("G3") = "Thursday" Then
Range("G3").Select
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("f3").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("c5:c13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("f4").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C3:C4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("f14").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("f16").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C15:C17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("f22").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C19:C22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("f25").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C34").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("f19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If Range("G3") = "Friday" Then
Range("G3").Select
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("g3").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("c5:c13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("g4").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C3:C4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("g14").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("g16").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C15:C17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("g22").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C19:C22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("g25").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C34").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("g19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
If Range("G3") = "Friday" Then
Range("G3").Select
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("h3").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("c5:c13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("h4").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C3:C4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("h14").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("h16").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C15:C17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("h22").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C19:C22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("h25").Select
ActiveSheet.Paste
Sheets("Daily Sales Record").Select
Range("C34").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Weekly Sales Record").Select
Range("h19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
Thanks for any help. I have been away from excel for awhile would really appreciate any help.
Sandy2976
|
|
