I m new to macro and I need to copy the data from row 26:27, 36:37, 46:47 cells value which are converted
into E9:F39, P9:Q39, AA9:AB39, 12 columns in the other workbook. How can I do if I want to import the data
directly instead of making a copy of the report inside of my workbook by using VBA? Thanks a lot if someone
can help me find problem!
Here is the import code that I have
Option Explicit
Public intBotRow, intTopRow As Integer ''STR data range definers
Public blExit As Boolean ''process terminator
Public strSTRReport As String ''name of the STR Report
Public strYPTool As String ''name of the YP Tool
Public d, e, f As Integer
Sub MasterImporter()
''==========================================================================================
''Program : MasterImporter
''Called by : ---
''In Module : Sheets("Instructions")
''Call : ClearData, LocateRange, WhatDates, GetData, CloseSTR, AnalysisSheet
''In Module : Import_Process
''Comments : Master Control for Import Process. Clears data,locates data range on the STR
'' report, imports data to YP tool then closesSTR report.
''==========================================================================================
Application.ScreenUpdating = False
blExit = False
Call OpenSTRReport
If blExit = True Then
Exit Sub
End If
Call ClearData
Call LocateRange
Call DeleteLogos
Call WhatDates
Call GetData
Call CloseSTR
With Sheets("Flash MTD")
.Visible = True
.Select
End With
MsgBox ("STR Data Imported. Please check the imported data and the downloaded file for any missing data")
Application.ScreenUpdating = True
End Sub
Sub OpenSTRReport()
''==========================================================================================
''Program : OpenSTRReport
''Called by : MasterImporter
''In Module : Import_Process
''Call : ---
''In Module : ---
''Comments : Allows the user to select the STR report to import data from. Will advise the
'' user if they are trying to open a workbook other than an STR report and will
'' cancel the process.
''==========================================================================================
Dim strMySTR As String
Dim NotSTR As VbMsgBoxResult
strYPTool = ActiveWorkbook.Name
strMySTR = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "Select the STR Report to Import")
If strMySTR = "False" Then
blExit = True
Exit Sub
End If
Workbooks.Open strMySTR
strSTRReport = ActiveWorkbook.Name
If Left(Cells(1, 2), 5) <> "Daily" Then
blExit = True
NotSTR = MsgBox("This is not an STR Report", vbCritical, "Caution!")
Workbooks(strSTRReport).Close (False)
End If
End Sub
Sub ClearData()
''==========================================================================================
''Program : ClearData
''Called by : MasterImporter
''In Module : Import_Process
''Comments : Clears old data from the "Flash MTD" worksheet.
''==========================================================================================
Windows(strYPTool).Activate
With Sheets("Flash MTD")
'Range(.Cells(5, 2), .Cells(41, 39)).ClearContents
Range(.Cells(5, 2), .Cells(76, 39)).ClearContents '12/07/2011
End With
With Sheets("Data")
Range(.Cells(1, 1), .Cells(600, 50)).ClearContents '12/07/2011
End With
End Sub
Sub LocateRange()
''==========================================================================================
''Program : LocateRange
''Called by : MasterImporter
''In Module : Import_Process
''Comments : Defines the top and bottom rows of the data on the STR Report.
''==========================================================================================
Dim a, b As Integer
Windows(strSTRReport).Activate
With Sheets("Daily")
d = 9
Do Until Cells(d, 2).Value = ""
d = d + 1
Loop
'd = d - 5 'YTD
d = d - 3 'YTD '12/07/2011
'e = d - 2
e = d - 9 'MTD '12/07/2011
Do Until Left(Cells(e, 2).Value, 5) = "Total"
e = e - 1
If e < 6 Then
e = 9
GoTo NextE
End If
Loop
e = e + 1
NextE:
intTopRow = e
intBotRow = d - 8 '12/07/2011
Cells.Select
Selection.Copy
''Range(Cells(6, 2), .Cells(600, 50)).Copy '12/07/2011
'Windows(strYPTool).Activate '12/07/2011
'ActiveWorkbook.Sheets("Data").Select '12/07/2011
'ActiveWorkbook.Sheets("Data").Cells(1, 1).Select '12/07/2011
'Selection.PasteSpecial Paste:=xlValues
'ActiveSheet.Copy After:=Workbooks(strYPTool).Sheets("Instructions")
'ActiveSheet.Visible = False
End With
Windows(strYPTool).Activate
Sheets("Data").Activate
With Sheets("Data")
Cells(1, 1).Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End With
'Windows(strYPTool).Activate '12/07/2011
'With ActiveWorkbook.Sheets("Data")
'Range(Cells(6, 2), .Cells(600, 50)).Select
'Cells(1, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'End With
End Sub
Sub DeleteLogos()
Dim DrObj
Dim Pict
Set DrObj = ActiveSheet.DrawingObjects
For Each Pict In DrObj
If Left(Pict.Name, 7) = "Picture" Then
Pict.Select
Pict.Delete
End If
Next
End Sub
Sub WhatDates()
''==========================================================================================
''Program : WhatDates
''Called by : MasterImporter
''In Module : Import_Process
''Comments : Changes Dates automatically on the Instructions sheet.
''==========================================================================================
Dim strMyMonth As String
Dim intMyYear As String
Windows(strSTRReport).Activate
With Sheets("Daily")
strMyMonth = WorksheetFunction.Text(.Cells(intTopRow, 2), "Mmmm")
intMyYear = WorksheetFunction.Text(.Cells(intTopRow, 2), "YYYY")
End With
Windows(strYPTool).Activate
With Sheets("Instructions")
.Cells(7, 4).Value = strMyMonth
.Cells(9, 4).Value = intMyYear
End With
End Sub
Sub GetData()
''==========================================================================================
''Program : GetData
''Called by : MasterImporter
''In Module : Import_Process
''Comments : Imports data from the STR Report. First loop gets MTD, Second gets YTD and Third
'' gets daily data.
'' 12/07/2011 : Fourth loop gets YTD DOW data, Fifth loop gets YTD WD/WE, Sixth loop gets YTD again
''==========================================================================================
Dim OccHTY, OccCTY, OccHLY, OccCLY As Double
Dim ADRHTY, ADRCTY, ADRHLY, ADRCLY As Double
Dim RevParHTY, RevParCTY, RevParHLY, RevParCLY As Double
Dim a, b, c As Integer
Dim MyRow, MyYPRow As Integer
''Get Period to Date Data
'For a = 1 To 3
For a = 1 To 6 '12/07/2011
Select Case a
Case 1
b = 1
'MyRow = d - 1
MyRow = d - 8 '12/07/2011
MyYPRow = 5
Case 2
b = 1
MyRow = d
MyYPRow = 6
Case 3
b = intBotRow - intTopRow
MyRow = intTopRow
MyYPRow = 11
Case 4 '12/07/2011
b = 7 '12/07/2011
MyRow = intBotRow + 1 '12/07/2011
MyYPRow = 42 '12/07/2011
Case 5 '12/07/2011
b = 2 '12/07/2011
MyRow = d + 1 '12/07/2011
MyYPRow = 51 '12/07/2011
Case 6 '12/07/2011
b = 1 '12/07/2011
MyRow = d '12/07/2011
MyYPRow = 49 ' 12/07/2011
End Select
For c = 1 To b
Dim OccRge, OccRgC, ADRRge, ADRRgC, RevParRge, RevParRgC As String
Windows(strSTRReport).Activate
With Sheets("Daily")
OccHTY = .Cells(MyRow + (c - 1), 5).Value / 100
OccCTY = .Cells(MyRow + (c - 1), 6).Value / 100
OccHLY = .Cells(MyRow + (c - 1), 7).Value / 100
OccCLY = .Cells(MyRow + (c - 1), 8).Value / 100
OccRge = .Cells(MyRow + (c - 1), 13).Value
OccRgC = .Cells(MyRow + (c - 1), 14).Value
ADRHTY = .Cells(MyRow + (c - 1), 16).Value
ADRCTY = .Cells(MyRow + (c - 1), 17).Value
ADRHLY = .Cells(MyRow + (c - 1), 18).Value
ADRCLY = .Cells(MyRow + (c - 1), 19).Value
ADRRge = .Cells(MyRow + (c - 1), 24).Value
ADRRgC = .Cells(MyRow + (c - 1), 25).Value
RevParHTY = .Cells(MyRow + (c - 1), 27).Value
RevParCTY = .Cells(MyRow + (c - 1), 28).Value
RevParHLY = .Cells(MyRow + (c - 1), 29).Value
RevParCLY = .Cells(MyRow + (c - 1), 30).Value
RevParRge = .Cells(MyRow + (c - 1), 35).Value
RevParRgC = .Cells(MyRow + (c - 1), 36).Value
End With
Windows(strYPTool).Activate
With Sheets("Flash MTD")
.Cells(MyYPRow + (c - 1), 2).Value = OccHTY
.Cells(MyYPRow + (c - 1), 3).Value = OccCTY
.Cells(MyYPRow + (c - 1), 7).Value = OccHLY
.Cells(MyYPRow + (c - 1), 8).Value = OccCLY
.Cells(MyYPRow + (c - 1), 9).Value = OccRge
.Cells(MyYPRow + (c - 1), 10).Value = OccRgC
.Cells(MyYPRow + (c - 1), 14).Value = ADRHTY
.Cells(MyYPRow + (c - 1), 15).Value = ADRCTY
.Cells(MyYPRow + (c - 1), 19).Value = ADRHLY
.Cells(MyYPRow + (c - 1), 20).Value = ADRCLY
.Cells(MyYPRow + (c - 1), 21).Value = ADRRge
.Cells(MyYPRow + (c - 1), 22).Value = ADRRgC
.Cells(MyYPRow + (c - 1), 26).Value = RevParHTY
.Cells(MyYPRow + (c - 1), 27).Value = RevParCTY
.Cells(MyYPRow + (c - 1), 31).Value = RevParHLY
.Cells(MyYPRow + (c - 1), 32).Value = RevParCLY
.Cells(MyYPRow + (c - 1), 33).Value = RevParRge
.Cells(MyYPRow + (c - 1), 34).Value = RevParRgC
End With
Next c
Next a
End Sub
Sub CloseSTR()
Windows(strSTRReport).Close
End Sub
into E9:F39, P9:Q39, AA9:AB39, 12 columns in the other workbook. How can I do if I want to import the data
directly instead of making a copy of the report inside of my workbook by using VBA? Thanks a lot if someone
can help me find problem!
Here is the import code that I have
Option Explicit
Public intBotRow, intTopRow As Integer ''STR data range definers
Public blExit As Boolean ''process terminator
Public strSTRReport As String ''name of the STR Report
Public strYPTool As String ''name of the YP Tool
Public d, e, f As Integer
Sub MasterImporter()
''==========================================================================================
''Program : MasterImporter
''Called by : ---
''In Module : Sheets("Instructions")
''Call : ClearData, LocateRange, WhatDates, GetData, CloseSTR, AnalysisSheet
''In Module : Import_Process
''Comments : Master Control for Import Process. Clears data,locates data range on the STR
'' report, imports data to YP tool then closesSTR report.
''==========================================================================================
Application.ScreenUpdating = False
blExit = False
Call OpenSTRReport
If blExit = True Then
Exit Sub
End If
Call ClearData
Call LocateRange
Call DeleteLogos
Call WhatDates
Call GetData
Call CloseSTR
With Sheets("Flash MTD")
.Visible = True
.Select
End With
MsgBox ("STR Data Imported. Please check the imported data and the downloaded file for any missing data")
Application.ScreenUpdating = True
End Sub
Sub OpenSTRReport()
''==========================================================================================
''Program : OpenSTRReport
''Called by : MasterImporter
''In Module : Import_Process
''Call : ---
''In Module : ---
''Comments : Allows the user to select the STR report to import data from. Will advise the
'' user if they are trying to open a workbook other than an STR report and will
'' cancel the process.
''==========================================================================================
Dim strMySTR As String
Dim NotSTR As VbMsgBoxResult
strYPTool = ActiveWorkbook.Name
strMySTR = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "Select the STR Report to Import")
If strMySTR = "False" Then
blExit = True
Exit Sub
End If
Workbooks.Open strMySTR
strSTRReport = ActiveWorkbook.Name
If Left(Cells(1, 2), 5) <> "Daily" Then
blExit = True
NotSTR = MsgBox("This is not an STR Report", vbCritical, "Caution!")
Workbooks(strSTRReport).Close (False)
End If
End Sub
Sub ClearData()
''==========================================================================================
''Program : ClearData
''Called by : MasterImporter
''In Module : Import_Process
''Comments : Clears old data from the "Flash MTD" worksheet.
''==========================================================================================
Windows(strYPTool).Activate
With Sheets("Flash MTD")
'Range(.Cells(5, 2), .Cells(41, 39)).ClearContents
Range(.Cells(5, 2), .Cells(76, 39)).ClearContents '12/07/2011
End With
With Sheets("Data")
Range(.Cells(1, 1), .Cells(600, 50)).ClearContents '12/07/2011
End With
End Sub
Sub LocateRange()
''==========================================================================================
''Program : LocateRange
''Called by : MasterImporter
''In Module : Import_Process
''Comments : Defines the top and bottom rows of the data on the STR Report.
''==========================================================================================
Dim a, b As Integer
Windows(strSTRReport).Activate
With Sheets("Daily")
d = 9
Do Until Cells(d, 2).Value = ""
d = d + 1
Loop
'd = d - 5 'YTD
d = d - 3 'YTD '12/07/2011
'e = d - 2
e = d - 9 'MTD '12/07/2011
Do Until Left(Cells(e, 2).Value, 5) = "Total"
e = e - 1
If e < 6 Then
e = 9
GoTo NextE
End If
Loop
e = e + 1
NextE:
intTopRow = e
intBotRow = d - 8 '12/07/2011
Cells.Select
Selection.Copy
''Range(Cells(6, 2), .Cells(600, 50)).Copy '12/07/2011
'Windows(strYPTool).Activate '12/07/2011
'ActiveWorkbook.Sheets("Data").Select '12/07/2011
'ActiveWorkbook.Sheets("Data").Cells(1, 1).Select '12/07/2011
'Selection.PasteSpecial Paste:=xlValues
'ActiveSheet.Copy After:=Workbooks(strYPTool).Sheets("Instructions")
'ActiveSheet.Visible = False
End With
Windows(strYPTool).Activate
Sheets("Data").Activate
With Sheets("Data")
Cells(1, 1).Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End With
'Windows(strYPTool).Activate '12/07/2011
'With ActiveWorkbook.Sheets("Data")
'Range(Cells(6, 2), .Cells(600, 50)).Select
'Cells(1, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'End With
End Sub
Sub DeleteLogos()
Dim DrObj
Dim Pict
Set DrObj = ActiveSheet.DrawingObjects
For Each Pict In DrObj
If Left(Pict.Name, 7) = "Picture" Then
Pict.Select
Pict.Delete
End If
Next
End Sub
Sub WhatDates()
''==========================================================================================
''Program : WhatDates
''Called by : MasterImporter
''In Module : Import_Process
''Comments : Changes Dates automatically on the Instructions sheet.
''==========================================================================================
Dim strMyMonth As String
Dim intMyYear As String
Windows(strSTRReport).Activate
With Sheets("Daily")
strMyMonth = WorksheetFunction.Text(.Cells(intTopRow, 2), "Mmmm")
intMyYear = WorksheetFunction.Text(.Cells(intTopRow, 2), "YYYY")
End With
Windows(strYPTool).Activate
With Sheets("Instructions")
.Cells(7, 4).Value = strMyMonth
.Cells(9, 4).Value = intMyYear
End With
End Sub
Sub GetData()
''==========================================================================================
''Program : GetData
''Called by : MasterImporter
''In Module : Import_Process
''Comments : Imports data from the STR Report. First loop gets MTD, Second gets YTD and Third
'' gets daily data.
'' 12/07/2011 : Fourth loop gets YTD DOW data, Fifth loop gets YTD WD/WE, Sixth loop gets YTD again
''==========================================================================================
Dim OccHTY, OccCTY, OccHLY, OccCLY As Double
Dim ADRHTY, ADRCTY, ADRHLY, ADRCLY As Double
Dim RevParHTY, RevParCTY, RevParHLY, RevParCLY As Double
Dim a, b, c As Integer
Dim MyRow, MyYPRow As Integer
''Get Period to Date Data
'For a = 1 To 3
For a = 1 To 6 '12/07/2011
Select Case a
Case 1
b = 1
'MyRow = d - 1
MyRow = d - 8 '12/07/2011
MyYPRow = 5
Case 2
b = 1
MyRow = d
MyYPRow = 6
Case 3
b = intBotRow - intTopRow
MyRow = intTopRow
MyYPRow = 11
Case 4 '12/07/2011
b = 7 '12/07/2011
MyRow = intBotRow + 1 '12/07/2011
MyYPRow = 42 '12/07/2011
Case 5 '12/07/2011
b = 2 '12/07/2011
MyRow = d + 1 '12/07/2011
MyYPRow = 51 '12/07/2011
Case 6 '12/07/2011
b = 1 '12/07/2011
MyRow = d '12/07/2011
MyYPRow = 49 ' 12/07/2011
End Select
For c = 1 To b
Dim OccRge, OccRgC, ADRRge, ADRRgC, RevParRge, RevParRgC As String
Windows(strSTRReport).Activate
With Sheets("Daily")
OccHTY = .Cells(MyRow + (c - 1), 5).Value / 100
OccCTY = .Cells(MyRow + (c - 1), 6).Value / 100
OccHLY = .Cells(MyRow + (c - 1), 7).Value / 100
OccCLY = .Cells(MyRow + (c - 1), 8).Value / 100
OccRge = .Cells(MyRow + (c - 1), 13).Value
OccRgC = .Cells(MyRow + (c - 1), 14).Value
ADRHTY = .Cells(MyRow + (c - 1), 16).Value
ADRCTY = .Cells(MyRow + (c - 1), 17).Value
ADRHLY = .Cells(MyRow + (c - 1), 18).Value
ADRCLY = .Cells(MyRow + (c - 1), 19).Value
ADRRge = .Cells(MyRow + (c - 1), 24).Value
ADRRgC = .Cells(MyRow + (c - 1), 25).Value
RevParHTY = .Cells(MyRow + (c - 1), 27).Value
RevParCTY = .Cells(MyRow + (c - 1), 28).Value
RevParHLY = .Cells(MyRow + (c - 1), 29).Value
RevParCLY = .Cells(MyRow + (c - 1), 30).Value
RevParRge = .Cells(MyRow + (c - 1), 35).Value
RevParRgC = .Cells(MyRow + (c - 1), 36).Value
End With
Windows(strYPTool).Activate
With Sheets("Flash MTD")
.Cells(MyYPRow + (c - 1), 2).Value = OccHTY
.Cells(MyYPRow + (c - 1), 3).Value = OccCTY
.Cells(MyYPRow + (c - 1), 7).Value = OccHLY
.Cells(MyYPRow + (c - 1), 8).Value = OccCLY
.Cells(MyYPRow + (c - 1), 9).Value = OccRge
.Cells(MyYPRow + (c - 1), 10).Value = OccRgC
.Cells(MyYPRow + (c - 1), 14).Value = ADRHTY
.Cells(MyYPRow + (c - 1), 15).Value = ADRCTY
.Cells(MyYPRow + (c - 1), 19).Value = ADRHLY
.Cells(MyYPRow + (c - 1), 20).Value = ADRCLY
.Cells(MyYPRow + (c - 1), 21).Value = ADRRge
.Cells(MyYPRow + (c - 1), 22).Value = ADRRgC
.Cells(MyYPRow + (c - 1), 26).Value = RevParHTY
.Cells(MyYPRow + (c - 1), 27).Value = RevParCTY
.Cells(MyYPRow + (c - 1), 31).Value = RevParHLY
.Cells(MyYPRow + (c - 1), 32).Value = RevParCLY
.Cells(MyYPRow + (c - 1), 33).Value = RevParRge
.Cells(MyYPRow + (c - 1), 34).Value = RevParRgC
End With
Next c
Next a
End Sub
Sub CloseSTR()
Windows(strSTRReport).Close
End Sub
Last edited:
