range variant looping macro many workbooks

[cometorta]

Hi,

I have a complicated problem for excel 2003 , maybe not for a power user.

I have about 20 different workbooks and i want to create identical tables and graphs in each one of them using the least number of steps.

The number of the rows changes by workbook but the colums are identical. So the range will vary by workbook.

so for example:

workbook1=

name sales
a 10
b 20
c 30


workbook2=
name sales
a 10

So I want a macro that does the tabling and charting in workbook1 and automatically moves to workbook2 and so on.


Thanks in advance for the informantion.

Francisco

 

[cometorta]

Hi Ravi,

Take a look, not the most efficient way but it does the trick. Thanks. Francisco

Sub lop_allsheets_allwbs2()
'modify to do all sheet1s

'Sub FillAcrossSheets2()
'FillAcrossSheets2
'Dim ws As Worksheet
'For Each ws In Worksheets
'ws.Activate
'Range("A2") = "hi"
'Next ws
'End Sub


Dim z As Long, e As Long, x As Long
Dim f As String, m As String
Dim ws As Worksheet
Application.ScreenUpdating = False
Sheets("Sheet1").Select
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")

Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop




z = Cells(Rows.Count, 1).End(xlUp).Row
For e = 2 To z




If Cells(e, 1) <> ActiveWorkbook.Name Then
n = Cells(e, 1)
Workbooks.Open Filename:=Cells(1, 2) & Cells(e, 1)


For Each ws In Worksheets
ws.Activate

x = Cells(Rows.Count, 1).End(xlUp).Row
'count the number of workbooks and loop it

m = ActiveSheet.Name

Sheets(m).Range("A2:B" & x).Select
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets(m).Range("A2:B" & x), PlotBy _
:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:=m

With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Bar chart"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Month"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "sales"
End With

Next ws

ActiveWorkbook.Close True
End If
Next e
Application.ScreenUpdating = True
MsgBox "collating is complete."
End Sub