iflaneur
10-03-2013, 04:22 AM
Hey guys,
I want to use the script below to copy:
- the content of Sheet "RAWDATA" in file C:\Client Reports\Delivery.xls
- into Sheet "RAWDATAClient" in the active workbook
but don't know where to specify the source file and the destination sheet
Can you help me?
Sub ImportRangeFromWB(SourceFile As String, SourceSheet As String, _
SourceAddress As String, PasteValuesOnly As Boolean, _
TargetWB As String, TargetWS As String, TargetAddress As String)
' Imports the data in Workbooks(SourceFile).Worksheets(SourceSheet).Range(SourceAddress)
' to Workbooks(TargetWB).Worksheets(TargetWS).Range(TargetAddress)
' Replaces existing data in Workbooks(TargetWB).Worksheets(TargetWS)
' without prompting for confirmation
' Example
' ImportRangeFromWB "C:\FolderName\TargetWB.xls", _
"Sheet1", "A1:E21", True, _
ThisWorkbook.Name, "ImportSheet", "A3"
Dim SourceWB As Workbook, SourceWS As String, SourceRange As Range
Dim TargetRange As Range, A As Integer, tString As String
Dim r As Long, c As Integer
' validate the input data if necessary
If Dir(SourceFile) = "" Then Exit Sub ' SourceFile doesn't exist
Set SourceWB = Workbooks.Open(SourceFile, True, True)
Application.StatusBar = "Reading data from " & SourceFile
Application.ScreenUpdating = False ' turn off the screen updating
Workbooks(TargetWB).Activate
Worksheets(TargetWS).Activate
' perform import
Set TargetRange = Range(TargetAddress).Cells(1, 1)
Set SourceRange = SourceWB.Worksheets(SourceSheet).Range(SourceAddress)
For A = 1 To SourceRange.Areas.Count
SourceRange.Areas(A).Copy
If PasteValuesOnly Then
TargetRange.PasteSpecial xlPasteValues
TargetRange.PasteSpecial xlPasteFormats
Else
TargetRange.PasteSpecial xlPasteAll
End If
Application.CutCopyMode = False
If SourceRange.Areas.Count > 1 Then
Set TargetRange = _
TargetRange.Offset(SourceRange.Areas(A).Rows.Count, 0)
End If
Next A
' clean up
Set SourceRange = Nothing
Set TargetRange = Nothing
Range(TargetAddress).Cells(1, 1).Select
SourceWB.Close False
Set SourceWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True ' turn on the screen updating
End Sub
Thank you very much!
Daniele
I want to use the script below to copy:
- the content of Sheet "RAWDATA" in file C:\Client Reports\Delivery.xls
- into Sheet "RAWDATAClient" in the active workbook
but don't know where to specify the source file and the destination sheet
Can you help me?
Sub ImportRangeFromWB(SourceFile As String, SourceSheet As String, _
SourceAddress As String, PasteValuesOnly As Boolean, _
TargetWB As String, TargetWS As String, TargetAddress As String)
' Imports the data in Workbooks(SourceFile).Worksheets(SourceSheet).Range(SourceAddress)
' to Workbooks(TargetWB).Worksheets(TargetWS).Range(TargetAddress)
' Replaces existing data in Workbooks(TargetWB).Worksheets(TargetWS)
' without prompting for confirmation
' Example
' ImportRangeFromWB "C:\FolderName\TargetWB.xls", _
"Sheet1", "A1:E21", True, _
ThisWorkbook.Name, "ImportSheet", "A3"
Dim SourceWB As Workbook, SourceWS As String, SourceRange As Range
Dim TargetRange As Range, A As Integer, tString As String
Dim r As Long, c As Integer
' validate the input data if necessary
If Dir(SourceFile) = "" Then Exit Sub ' SourceFile doesn't exist
Set SourceWB = Workbooks.Open(SourceFile, True, True)
Application.StatusBar = "Reading data from " & SourceFile
Application.ScreenUpdating = False ' turn off the screen updating
Workbooks(TargetWB).Activate
Worksheets(TargetWS).Activate
' perform import
Set TargetRange = Range(TargetAddress).Cells(1, 1)
Set SourceRange = SourceWB.Worksheets(SourceSheet).Range(SourceAddress)
For A = 1 To SourceRange.Areas.Count
SourceRange.Areas(A).Copy
If PasteValuesOnly Then
TargetRange.PasteSpecial xlPasteValues
TargetRange.PasteSpecial xlPasteFormats
Else
TargetRange.PasteSpecial xlPasteAll
End If
Application.CutCopyMode = False
If SourceRange.Areas.Count > 1 Then
Set TargetRange = _
TargetRange.Offset(SourceRange.Areas(A).Rows.Count, 0)
End If
Next A
' clean up
Set SourceRange = Nothing
Set TargetRange = Nothing
Range(TargetAddress).Cells(1, 1).Select
SourceWB.Close False
Set SourceWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True ' turn on the screen updating
End Sub
Thank you very much!
Daniele