PDA

View Full Version : Unfinished Macro Copy cells from different Workbooks to a Main Workbook



ramez75
10-01-2008, 12:31 PM
Hi everyone,

I have been working on the macro for few days. I have an idea of the logic but I cant get the the paste command to work as I want it.
Below is the macro the only thing i need is to paste the results Cell O6 and O10.

Well what I have is a folder with workbooks named monthyear.xls and in each workbook I have worksheets named in the format MMYY-1, MMYY-2, etc. Also in the folder there is a Main/Master Workbook which eventually if the macro works will have 3 to 4 sheets which will generate reports. Hence the macro will only run from the Main Workbook Sheet(2) for simplicity. The macro will go into all the workbooks and all the different worksheets within the workbooks and if the IF condition within the macro is not met then will copy the cell values O6 and O10 to the Main workbook Sheet(2) and paste them in columns A and B starting at A2, B2 and working its way down. A1 and B1 are headers and will never be touched.

So if i have lets say 20 Worksheets within all the workbooks combined that did not meet the IF condition within the macro then I will have the different values of O6 and O10 from those sheets pasted in A2, A3.....A21 & B2, B3,.....B21.

Hope I made sense. Let me know if i need to be more clearer

Any help will be greatly appreciated.

Thanks in advance


Sub Report2()
Dim i As Integer
Dim Wkb As Workbook, Main As Workbook
Dim ws As Worksheet
Dim FileName As String, Path As String, ThisWB As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Set Main = ThisWorkbook
ThisWB = ThisWorkbook.Name

' Clear all content and set formatting within the "Open NCR Report" except the Header
Main.Activate
ActiveSheet.Range("A2:C65532").Select
Selection.ClearContents
Selection.Interior.ColorIndex = 35
Selection.RowHeight = 18
Selection.ColumnWidth = 30
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

' Loop to go through all the Workbooks

Path = "C:\Documents and Settings\ramez.boudargham\Desktop\Forms\NCR Forms\"
FileName = Dir(Path & "\*.xls", vbNormal)

Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For i = 1 To Sheets.Count ' Loop through all NCR's within the same month
If Sheets(i).Visible = True Then ' Exclude hidden sheets
Sheets(i).Select
Set ws = Sheets(i) ' Set Opened Worksheet as the working Worksheet
If ws.Name = "Create New NCR Form" Then GoTo NextSheet
If ws.Range("D34") = "" Or ws.Range("L28") = "" Or ws.Range("G28") = "" Then

' NEED to PASTE IN MAIN WORKBOOK SHEET2. ALL O6'S VALUES WILL GO IN COLUMN A AND O10'S VALUES IN
' COLUMN B. COLUMN C WILL CALCULATE DAYS BY USING DATES VALUE IN COLUMN B AND CURRENT DATE; TODAY()
ws.Range("O6").Copy

ws.Range("O10").Copy

End If
End If
NextSheet:
Next i
Wkb.Close False
End If
FileName = Dir()
Loop

Range("E1").Select ' Highlight Command Button Click

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.CutCopyMode = False

End Sub

rbrhodes
10-01-2008, 11:43 PM
Hi ramez75,

Try this...


Option Explicit
Sub Report2()
Dim i As Integer
Dim Wkb As Workbook, Main As Workbook

'//
Dim DestRow As Long


Dim ws As Worksheet
Dim FileName As String, Path As String, ThisWB As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With

Set Main = ThisWorkbook
ThisWB = ThisWorkbook.Name

' Clear all content and set formatting within the "Open NCR Report" except the Header
Main.Activate
ActiveSheet.Range("A2:C65532").Select

' // Use With /End With
With Selection
.ClearContents
.Interior.ColorIndex = 35
.RowHeight = 18
.ColumnWidth = 30
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

'// Set start row as 2
DestRow = 2

' Loop to go through all the Workbooks
Path = "C:\Documents and Settings\ramez.boudargham\Desktop\Forms\NCR Forms\"
FileName = Dir(Path & "\*.xls", vbNormal)

Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For i = 1 To Sheets.Count ' Loop through all NCR's within the same month
If Sheets(i).Visible = True Then ' Exclude hidden sheets
Sheets(i).Select
Set ws = Sheets(i) ' Set Opened Worksheet as the working Worksheet
If ws.Name = "Create New NCR Form" Then GoTo NextSheet
If ws.Range("D34") = "" Or ws.Range("L28") = "" Or ws.Range("G28") = "" Then

' NEED to PASTE IN MAIN WORKBOOK

'// ****SHEET2****

' ALL O6'S VALUES WILL GO
'IN COLUMN A AND O10'S VALUES IN COLUMN B. COLUMN C WILL CALCULATE
'DAYS BY USING DATES VALUE IN COLUMN B AND CURRENT DATE; TODAY()


' //Above says Sheet 2 ?
ws.Range("O6").Copy Destination:=Main.Sheets(2).Cells(DestRow, 1)

ws.Range("O10").Copy Destination:=Main.Sheets(2).Cells(DestRow, 2)

' Increment destination row
DestRow = DestRow + 1

End If
End If
NextSheet:
Next i
Wkb.Close False
End If
FileName = Dir()
Loop

Range("E1").Select ' Highlight Command Button Click

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.CutCopyMode = False
End With
End Sub

ramez75
10-02-2008, 05:15 AM
Thank you very much rbrhodes.
It worked my fault was I didnt assign the where to copy it too. I presumed that since I declared at the beginning of the macro "Set Main = ThisWorkbook" I thought that it will paste everything in what I set as 'This Workbook'. So learned something new.
I like the way you use With and End With, It makes the code looks neat and clean does it also helps in speeding up the execution.
I had to change

ws.Range("O6").Copy Destination:=Main.Sheets(2).Cells(DestRow, 1)

To


ws.Range("O6").Copy Destination:=Main.Sheets("Open NCR Report").Cells(DestRow, 1)

The macro wouldnt take the sheet number needed the name to get rid of the error runtime 9. For my knowledge why is that.

Another question and sorry if I am asking alot I am just trying to learn and get good at it. What is the advantage of Option Explicit. I know what it does correct me if I am wrong it tells excel that all VBA variables must be explicitluy declared instead of assuming as Variant but I/we are declaring the variable at the beginning of the code whether they are integers, object, variant, etc

Thanks again for the help

Ramez

ramez75
10-02-2008, 12:05 PM
Another thing I was trying to add to the code a way to format Only the used cells nothing else
Right now I clean the report using the below selection


.ClearContents
.Interior.ColorIndex = 35
.RowHeight = 18
.ColumnWidth = 30
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone

If ofcourse let say I have 10 worksheets out of all the workbooks that didnt meet the IF CONDITION then I will have values in 10 rows (eg:A2:B11) this will change; sometime i will have more sometime less. I want the cells that have values in to have the below format:


With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Size = 14
.Font.Bold = False
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Interior.ColorIndex = xlAutomatic
End With

I tried putting it below


ws.Range("O6").Copy Destination:=Main.Sheets("Open NCR Report").Cells(DestRow, 1)
ws.Range("O10").Copy Destination:=Main.Sheets("Open NCR Report").Cells(DestRow, 2)


the macro will not run. If I move it to below
Loop statement then it will format A2 and B2 all the way till the last row (65536). I cant figure it out.

Having same problem with the print area. Below is the only way I can make it work which is not dynamic since my occupied rows will change.


ActiveSheet.PageSetup.PrintArea = "$A$1:$B$10"

I tried using


ActiveSheet.PageSetup.PrintArea = UsedRange.Address no luck either.

Any guidance will be appreciated

Thanks

rbrhodes
10-02-2008, 08:58 PM
Hi Ramez,

Option Explicit requires variable declaration that's true. So when you make a mistake in the codse it will catch it. Thats the beauty of it eg:



Dim MyVariable as long

<...some code...

NyVariable = 22

...more code...>


Notice in the above that MyVariable is mispelled and therefore MyVariable does not get changed to equal 22. A fatal error for the code. If Option Explicit is used it stops and gives an error message on NyVariable allowing you to correct the mistake.

The optional Destination:= argument of the .Copy command is the easiest way to copy/paste (IMHO) There are other ways...


There are 3 ways to address a sheet

1) Sheets(2) looks for the second displayed sheet tab. If there is only one sheet then "Subscript out of range" error results. Also if the position of the desired destination sheet changes the result is not what was desired!

2) Sheets("The Name of the Sheet"). Looks for the Sheet's name. This could be a problem if the name is changed later

3) Sheet2 the CodeName of the sheet, asssigned and maintained by Excel you can find it by opening the VBE <Alt+F11> and looking in the 'Project Explorer' Window to the left of the code. Ctrl+R to display it or View/Project Explorer. In the VBE. This is the best way as changing sheet names or display order does not affect the code. Note the difference between Sheet(2) and Sheet2. The first one is the Displayed Sheet tab order!

...and here I've tried to do what I think you wanted. Look in the code for comments...


Option Explicit
Sub Report2()
Dim i As Integer
Dim Wkb As Workbook, Main As Workbook

'//
Dim LastRow As Long


Dim DestRow As Long
Dim ws As Worksheet
Dim FileName As String, Path As String, ThisWB As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With

Set Main = ThisWorkbook
ThisWB = ThisWorkbook.Name

' Clear all content and set formatting within the "Open NCR Report" except the Header
Main.Activate

'// As there will only be data in Col A & B get
' last row of data from Col B
LastRow = ActiveSheet.Range("B65532").End(xlUp).Row

' // Get range of cells currently used
With Range(Cells(1, 1), Cells(LastRow, 2))
' No data
.ClearContents
' No colour
.Interior.ColorIndex = xlNone
' Default Hieght and Width
.RowHeight = 12.75
.ColumnWidth = 8.43
' Default align
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom

' No lines
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
End With

'// Set start row as 2
DestRow = 2

' Loop to go through all the Workbooks
Path = "C:\Documents and Settings\ramez.boudargham\Desktop\Forms\NCR Forms\"
FileName = Dir(Path & "\*.xls", vbNormal)

Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For i = 1 To Sheets.Count ' Loop through all NCR's within the same month
If Sheets(i).Visible = True Then ' Exclude hidden sheets
Sheets(i).Select
Set ws = Sheets(i) ' Set Opened Worksheet as the working Worksheet
If ws.Name = "Create New NCR Form" Then GoTo NextSheet
If ws.Range("D34") = "" Or ws.Range("L28") = "" Or ws.Range("G28") = "" Then

' NEED to PASTE IN MAIN WORKBOOK

'// ****SHEET2****

' ALL O6'S VALUES WILL GO
'IN COLUMN A AND O10'S VALUES IN COLUMN B. COLUMN C WILL CALCULATE
'DAYS BY USING DATES VALUE IN COLUMN B AND CURRENT DATE; TODAY()


' //Above says Sheet 2 ?
ws.Range("O6").Copy Destination:=Main.Sheets(2).Cells(DestRow, 1)

ws.Range("O10").Copy Destination:=Main.Sheets(2).Cells(DestRow, 2)

' Increment destination row
DestRow = DestRow + 1

End If
End If
NextSheet:
Next i
Wkb.Close False
End If
FileName = Dir()
Loop

' Get new range of used rows
LastRow = Range("B65536").End(xlUp).Row

' Select it (not really necessary but easy to understand)
Range(Cells(1, 1), Cells(LastRow, 2)).Select

' Format it
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Size = 14
.Font.Bold = False
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Interior.ColorIndex = xlAutomatic
End With

'// Print setup


Activesheet.PageSetup.PrintArea = "$A$1:$B$" & LastRow

Range("E1").Select ' Highlight Command Button Click

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.CutCopyMode = False
End With
End Sub


PS I left the Select/Selection pairs in as they are the easiest to understand. There are better ways to manipulate ranges but that's a little more advanced at this point.

As for the Printing:

ramez75
10-03-2008, 05:53 AM
Thanks for taking the time and explaning the differences.

I also used another way to set the printarea


Activesheet.PageSetup.PrintArea = "$A$1:$B$" & Cells(DestRow - 1, 2)

What I did also just to get more familiarized and to Optimize I broke the code into Subroutines in that way I can use a couple of them in other macros like the clear content, Print area and format cells.

RB

ramez75
11-06-2008, 12:14 PM
To the same macro can i add input boxes that will ask for start and end date. The reason for that is, usually the workbook has 100 of worksheets and sometime i need to extract the specific cells that lies between certain dates. For example each worksheet has a date in cell O17 so the macro will not copy the specific cells unless the value in cell O17 lies between the input dates.

SO

LEt say i have 15 worksheets in October workbook
cell O17 of each worksheet are
1.10/1/2008
2.10/5/2008
3.10/7/2008
4.10/7/2008
.
.
.
14.10/25/2008
15.10/28/2008

So if i run the macro, I input Start Date 10/5/2008 and End Date 10/7/2008.

Hence, I will copy specific cells from worksheets 2, 3 and 4 only.

Hope that make sense

Thank you

mdmackillop
11-06-2008, 12:33 PM
You can do all your borders at once

Sub NoBorder()
Selection.Borders.LineStyle = xlNone
End Sub

Sub Borders()
Selection.Borders.LineStyle = xlContinuous
End Sub