M
Mike Taylor
The following code copies entire worksheets. Can someone explain how
the code needs to be modified so that only cell values and formats are
copied from the same range of cells ("A133")in each worksheet rather
than copying the entire worksheet. I visited Ron's site,
http://www.rondebruin.nl/copy1.htm, and tried to figure out how to use
his examples without success...I just can't seem to figure it out. Any
help is greatly appreciated.
Mike Taylor
_____________________________________________________________________________
Sub GetRRRDheets()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim sh As Object
Dim mybook As Workbook
Dim myExistingPath As String
Dim myPathToRetrieve As String
myExistingPath = CurDir
'myPathToRetrieve = "c:\data\datafiles\data"
myPathToRetrieve = "v:\"
ChDrive myPathToRetrieve
ChDir myPathToRetrieve
varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)
If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
With wkbk.Worksheets("Remittance Report 2004")
On Error Resume Next
Set mybook = Workbooks.Open(.FoundFiles(i))
For Each sh In mybook.Sheets
ActiveWorkbook.Unprotect ("mbt")
ActiveSheet.Unprotect ("mbt")
Next sh
mybook.Close SaveChanges:=False
.UsedRange.Value = .UsedRange.Value
.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
ActiveSheet.Name = Format(Range("d2").Value, "000")
End With
wkbk.Close SaveChanges:=False
Next
End If
'reset it back
ChDrive myExistingPath
ChDir myExistingPath
End Sub
the code needs to be modified so that only cell values and formats are
copied from the same range of cells ("A133")in each worksheet rather
than copying the entire worksheet. I visited Ron's site,
http://www.rondebruin.nl/copy1.htm, and tried to figure out how to use
his examples without success...I just can't seem to figure it out. Any
help is greatly appreciated.
Mike Taylor
_____________________________________________________________________________
Sub GetRRRDheets()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim sh As Object
Dim mybook As Workbook
Dim myExistingPath As String
Dim myPathToRetrieve As String
myExistingPath = CurDir
'myPathToRetrieve = "c:\data\datafiles\data"
myPathToRetrieve = "v:\"
ChDrive myPathToRetrieve
ChDir myPathToRetrieve
varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)
If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
With wkbk.Worksheets("Remittance Report 2004")
On Error Resume Next
Set mybook = Workbooks.Open(.FoundFiles(i))
For Each sh In mybook.Sheets
ActiveWorkbook.Unprotect ("mbt")
ActiveSheet.Unprotect ("mbt")
Next sh
mybook.Close SaveChanges:=False
.UsedRange.Value = .UsedRange.Value
.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
ActiveSheet.Name = Format(Range("d2").Value, "000")
End With
wkbk.Close SaveChanges:=False
Next
End If
'reset it back
ChDrive myExistingPath
ChDir myExistingPath
End Sub