PDA

View Full Version : [SOLVED] Copy Data from a Workbook with multiple Worksheets to another Workbook



Campbell987
11-30-2013, 05:04 PM
Hi All!
I created a VBA macro to copy data from specific worksheets in a workbook to another workbook with the same worksheet names. I am having trouble looping through the workbook to copy data from each of the worksheets. I am not sure where I should place the "For" and "Next" statement. Also, I do not think the code I have for looping through the workbook is the correct code. There are 12 worksheets (i.e. Jan13, Feb13, Mar13, etc.). The worksheets names will be the same on both the source and target workbooks.

I am getting an error (I bold the statement below) where it states the "Object does not support this property or method".

Below is my VBA Code.

Any input would be very appreciated. Thanks in advance for your help.

- Ron -

Sub Copy_Data_Items()


' Copy items from Source Workbook to Target Workbook.


If MsgBox("Do You Want to Copy Data?", vbYesNo + vbDefaultButton2) = vbNo Then
End
End If


If MsgBox("Are you Sure?", vbYesNo + vbDefaultButton2) = vbNo Then
End
End If


Dim wbTarget As Workbook 'workbook where the data is to be pasted
Dim wbSource As Workbook 'workbook from where the data is to copied
Dim strSourceFile As String
Dim strTargetFile As String


strSourceFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13old.xlsm"
strTargetFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13new.xlsm"


Dim i As Long

'Set to the current active workbook (the source book)
Set wbSource = ActiveWorkbook

'Open a Target workbook
Set wbTarget = Workbooks.Open(strTargetFile)

For i = 1 To 12
Sheets(i + 1).Select


'Clear existing values from target book


Range("C12:G35") = ClearContents
Range("C38:G52") = ClearContents
Range("B60:G109") = ClearContents
Range("B116:G215") = ClearContents
Range("D216:G216") = ClearContents
Range("I66:O85") = ClearContents
Range("L086:O86") = ClearContents
Range("I94:O108") = ClearContents
Range("L109:O109") = ClearContents
Range("I118:O126") = ClearContents
Range("L127:O127") = ClearContents
Range("I135:O144") = ClearContents
Range("I153:O160") = ClearContents
Range("L161:O161") = ClearContents
Range("I169:O178") = ClearContents
Range("I186:O215") = ClearContents
Range("L216:O216") = ClearContents


'Select cell C12 on the target book
wbTarget.Range("C12:G35").Select

'Activate the source book
wbSource.Activate


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False


'Copy the range from source book
wbSource.Range("C12:G35").Copy


'Paste the data on the target book
wbTarget.Range("C12").PasteValues


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False


'Copy the range from source book
wbSource.Range("C38:G52").Copy


'Paste the data on the target book
wbTarget.Range("C38").PasteValues


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False


'Copy the range from source book
wbSource.Range("B60:G109").Copy


'Paste the data on the target book
wbTarget.Range("B60").PasteValues


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False


'Copy the range from source book
wbSource.Range("B116:G216").Copy


'Paste the data on the target book
wbTarget.Range("B116").PasteValues


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False


'Copy the range from source book
wbSource.Range("I66:O86").Copy


'Paste the data on the target book
wbTarget.Range("I66").PasteValues


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False


'Copy the range from source book
wbSource.Range("I94:O109").Copy


'Paste the data on the target book
wbTarget.Range("I94").PasteValues


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False


'Copy the range from source book
wbSource.Range("I118:O127").Copy


'Paste the data on the target book
wbTarget.Range("I118").PasteValues


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False


'Copy the range from source book
wbSource.Range("I135:O144").Copy


'Paste the data on the target book
wbTarget.Range("I135").PasteValues


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False


'Copy the range from source book
wbSource.Range("I153:O161").Copy


'Paste the data on the target book
wbTarget.Range("I153").PasteValues


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False


'Copy the range from source book
wbSource.Range("I169:O178").Copy


'Paste the data on the target book
wbTarget.Range("I169").PasteValues


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False


'Copy the range from source book
wbSource.Range("I186:O216").Copy


'Paste the data on the target book
wbTarget.Range("I186").PasteValues


'Clear anything on clipboard to maximize available memory
Application.CutCopyMode = False




'Save the target book
wbTarget.Save


'Close the workbook
wbTarget.Close


'Activate the source book again
wbSource.Activate

'Clear memory
Set wbTarget = Nothing
Set wbSource = Nothing


Range("A1").Select

PctDone = i / 12
With UserForm3
.FrameProgress.Caption = VBA.Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
' The DoEvents statement is responsible for the form updating
DoEvents

Next i

Unload UserForm3

End Sub

mancubus
12-01-2013, 07:22 AM
welcome to VBAX.

please use CODE tags when posting codes. clicking the # button in quick reply window will insert these tags for you.



assuming same worksheets have same sheet indexes in both workbooks and ranges listed will be copied to corresponding ranges in target workbook... try this.



Sub Copy_Data_Items()
' Copy items from Source Workbook to Target Workbook.


Dim wbTarget As Workbook 'workbook where the data is to be pasted
Dim wbSource As Workbook 'workbook from where the data is to copied
Dim strSourceFile As String
Dim strTargetFile As String
Dim i As Long

strSourceFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13old.xlsm"
strTargetFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13new.xlsm"

If MsgBox("Do You Want to Copy Data?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
If MsgBox("Are you Sure?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub

Set wbSource = ActiveWorkbook
Set wbTarget = Workbooks.Open(strTargetFile)

For i = 1 To 12
With wbTarget
.Sheets(i + 1).Range("C12:G35") = wbSource.Sheets(i + 1).Range("C12:G35")
.Sheets(i + 1).Range("C38:G52") = wbSource.Sheets(i + 1).Range("C38:G52")
.Sheets(i + 1).Range("B60:G109") = wbSource.Sheets(i + 1).Range("B60:G109")
.Sheets(i + 1).Range("B116:G215") = wbSource.Sheets(i + 1).Range("B116:G215")
.Sheets(i + 1).Range("D216:G216") = wbSource.Sheets(i + 1).Range("D216:G216")
.Sheets(i + 1).Range("I66:O85") = wbSource.Sheets(i + 1).Range("I66:O85")
.Sheets(i + 1).Range("L086:O86") = wbSource.Sheets(i + 1).Range("L086:O86")
.Sheets(i + 1).Range("I94:O108") = wbSource.Sheets(i + 1).Range("I94:O108")
.Sheets(i + 1).Range("L109:O109") = wbSource.Sheets(i + 1).Range("L109:O109")
.Sheets(i + 1).Range("I118:O126") = wbSource.Sheets(i + 1).Range("I118:O126")
.Sheets(i + 1).Range("L127:O127") = wbSource.Sheets(i + 1).Range("L127:O127")
.Sheets(i + 1).Range("I135:O144") = wbSource.Sheets(i + 1).Range("I135:O144")
.Sheets(i + 1).Range("I153:O160") = wbSource.Sheets(i + 1).Range("I153:O160")
.Sheets(i + 1).Range("L161:O161") = wbSource.Sheets(i + 1).Range("L161:O161")
.Sheets(i + 1).Range("I169:O178") = wbSource.Sheets(i + 1).Range("I169:O178")
.Sheets(i + 1).Range("I186:O215") = wbSource.Sheets(i + 1).Range("I186:O215")
.Sheets(i + 1).Range("L216:O216") = wbSource.Sheets(i + 1).Range("L216:O216")
End With
Next i

wbTarget.Close True


End Sub




PS: lines related with userform are omitted. i dont see the original file.

Campbell987
12-01-2013, 10:43 PM
Hi mancubus!
Thank you for your help with my code. I appreciate your time and effort with helping me.

I copied over your code and ran the macro and nothing was copied over from the "source" file to the "target" file. It did loop through all of the worksheets as coded but none of the data copied over. The code you provided should work but I am not sure why it is not working.

Again, thank you for providing the code. I will continue to work on it. Thanks!

- Ron -


welcome to VBAX.

please use CODE tags when posting codes. clicking the # button in quick reply window will insert these tags for you.



assuming same worksheets have same sheet indexes in both workbooks and ranges listed will be copied to corresponding ranges in target workbook... try this.



Sub Copy_Data_Items()
' Copy items from Source Workbook to Target Workbook.


Dim wbTarget As Workbook 'workbook where the data is to be pasted
Dim wbSource As Workbook 'workbook from where the data is to copied
Dim strSourceFile As String
Dim strTargetFile As String
Dim i As Long

strSourceFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13old.xlsm"
strTargetFile = "C:\Users\Ronola\Documents\My Safe\My Budget\Finance13new.xlsm"

If MsgBox("Do You Want to Copy Data?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
If MsgBox("Are you Sure?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub

Set wbSource = ActiveWorkbook
Set wbTarget = Workbooks.Open(strTargetFile)

For i = 1 To 12
With wbTarget
.Sheets(i + 1).Range("C12:G35") = wbSource.Sheets(i + 1).Range("C12:G35")
.Sheets(i + 1).Range("C38:G52") = wbSource.Sheets(i + 1).Range("C38:G52")
.Sheets(i + 1).Range("B60:G109") = wbSource.Sheets(i + 1).Range("B60:G109")
.Sheets(i + 1).Range("B116:G215") = wbSource.Sheets(i + 1).Range("B116:G215")
.Sheets(i + 1).Range("D216:G216") = wbSource.Sheets(i + 1).Range("D216:G216")
.Sheets(i + 1).Range("I66:O85") = wbSource.Sheets(i + 1).Range("I66:O85")
.Sheets(i + 1).Range("L086:O86") = wbSource.Sheets(i + 1).Range("L086:O86")
.Sheets(i + 1).Range("I94:O108") = wbSource.Sheets(i + 1).Range("I94:O108")
.Sheets(i + 1).Range("L109:O109") = wbSource.Sheets(i + 1).Range("L109:O109")
.Sheets(i + 1).Range("I118:O126") = wbSource.Sheets(i + 1).Range("I118:O126")
.Sheets(i + 1).Range("L127:O127") = wbSource.Sheets(i + 1).Range("L127:O127")
.Sheets(i + 1).Range("I135:O144") = wbSource.Sheets(i + 1).Range("I135:O144")
.Sheets(i + 1).Range("I153:O160") = wbSource.Sheets(i + 1).Range("I153:O160")
.Sheets(i + 1).Range("L161:O161") = wbSource.Sheets(i + 1).Range("L161:O161")
.Sheets(i + 1).Range("I169:O178") = wbSource.Sheets(i + 1).Range("I169:O178")
.Sheets(i + 1).Range("I186:O215") = wbSource.Sheets(i + 1).Range("I186:O215")
.Sheets(i + 1).Range("L216:O216") = wbSource.Sheets(i + 1).Range("L216:O216")
End With
Next i

wbTarget.Close True


End Sub




PS: lines related with userform are omitted. i dont see the original file.