Run a procedure in all the sheets of the workbook.

H

Heera

Hi,


I have five worksheets in a workbook and i want to right a code which
will perform a task in all the worksheets and copy the data to a
different workbook.
but i am getting a error i dont know what is going wrong in the code.
Here is my code.



Dim wsheet As Integer 'T stands for total worksheets
Dim CSheet As Integer 'C stands for count of worksheets

wsheet = ActiveWorkbook.Worksheets.Count



Dim Rsheet As Worksheet
For Each Rsheet In Worksheets

For CSheet = 1 To wsheet - 1
Range("B2").Select
Selection.End(xlToRight).Select
Selection.Offset(0, 1).Select
ActiveCell.Value = "Date"
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
"=MID(CELL(""filename"",R[-3]C[-11]),FIND(""]"",CELL
(""filename"",R[-3]C[-11]))+1,99)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Selection.TextToColumns Destination:=ActiveCell,
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows(TAname1).Activate
Sheets("Sheet3").Activate
ActiveSheet.Paste
Application.CutCopyMode = False

Windows(CAname1).Activate
ActiveCell.offset(1,0).select
ActiveSheet.Next.Select

Next CSheet
Next Rsheet

Regards

Heera
 
S

Susan

i don't know why you're using this:
For CSheet = 1 To wsheet - 1
i don't think it's necessary............
(in the future, please indent your code as shown - makes it much
easier to follow)
you can also shorten up your code quite a bit by removing the selects,
like this:

Range("B2").Select
Selection.End(xlToRight).Select
Selection.Offset(0, 1).Select
ActiveCell.Value = "Date"

could be shortened to

Range("B2").End(xlToRight).Offset(0, 1).Value = "Date"


sub Heera()

Dim Rsheet As Worksheet
dim myWorkbook as workbook

set myWorkbook = ActiveWorkbook

For Each Rsheet In myWorkbook.Worksheets

Range("B2").Select
Selection.End(xlToRight).Select
Selection.Offset(0, 1).Select
ActiveCell.Value = "Date"
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
"=MID(CELL(""filename"",R[-3]C[-11]),FIND(""]"",CELL
(""filename"",R[-3]C[-11]))+1,99)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Selection.TextToColumns Destination:=ActiveCell,
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows(TAname1).Activate
Sheets("Sheet3").Activate
ActiveSheet.Paste
Application.CutCopyMode = False

Windows(CAname1).Activate
ActiveCell.offset(1,0).select
ActiveSheet.Next.Select

Next Rsheet

End Sub




Hi,

I have five worksheets in a workbook and i want to right a code which
will perform a task in all the worksheets and copy the data to a
different workbook.
but i am getting a error i dont know what is going wrong in the code.
Here is my code.

Dim wsheet As Integer 'T stands for total worksheets
Dim CSheet As Integer 'C stands for count of worksheets

wsheet = ActiveWorkbook.Worksheets.Count

Dim Rsheet As Worksheet
For Each Rsheet In Worksheets

For CSheet = 1 To wsheet - 1
Range("B2").Select
Selection.End(xlToRight).Select
Selection.Offset(0, 1).Select
ActiveCell.Value = "Date"
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
        "=MID(CELL(""filename"",R[-3]C[-11]),FIND(""]"",CELL
(""filename"",R[-3]C[-11]))+1,99)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False

Selection.TextToColumns Destination:=ActiveCell,
DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows(TAname1).Activate
Sheets("Sheet3").Activate
ActiveSheet.Paste
Application.CutCopyMode = False

Windows(CAname1).Activate
ActiveCell.offset(1,0).select
ActiveSheet.Next.Select

Next CSheet
Next Rsheet

Regards

Heera
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

File Name changes with dates and Deleting Rows of Zeros 0
Macro to fill to next field with data 4
Something in this is causing a crash 2
Excel Macro to use cells as a autofilter 0
Loop to End 0
variable number of rows. 2
On error goto specified Line 6
exporting to Excel without overwriting the macros 4

Top