PDA

View Full Version : [SOLVED] Paste & Delete Via VBA



jo15765
04-19-2012, 11:37 AM
I am opening a "Master" Workbook, copying rows 4, 6, and 10 then opening about 30 other workbooks and pasting in rows 4, 6, and 10. The problem is that sometimes those rows in the workbooks I am pasting data have data. So I tried to run a function to delete the data when the workbook was opened, but that then caused Excel to forget what I had copied. How can I run the Delete/Paste simultaneously?

My 1st thought was to write a module that would 1st open the workbooks delete the problem. Then have a 2nd module to run that will paste in the good data, but to me that is double the code, and more room for error.

EDIT ----
I found this macro for word which will replace what is already there with what you are pasting in. Can you do the same thing for Excel?


Sub Paste()
If Selection.InlineShapes.Count > 0 Then
Selection.Delete
Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteEnhancedMetafilePicture
End If
End Sub

Bob Phillips
04-19-2012, 03:51 PM
Why not just re-copy that data after opening each target workbbok and clearing if required?

jo15765
04-19-2012, 06:32 PM
That may work and I am just not following how....

What I am doing is opening the "Master" copying the data, then opening the wb1, pasting data, save and close. Opening wb2 pasting data, save and close and so on and so forth.

In order to do what you are suggesting, I would need to open wb1, clear the data, go back to "Master" copy, focus back to wb1, paste then save and close. And repeat those steps for each subsequent wb, correct?

georgiboy
04-19-2012, 11:01 PM
Why not automate the whole process with something like...

Sub CopyRows()
Dim wbDst As Workbook, wbSrc As Workbook
Dim wsSrc As String, wsDst As String
Dim MyPath As String, strFilename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\Demo" 'change to suit. Multiple files
strFilename = Dir(MyPath & "\*.xls", vbNormal) 'change .xls to .xlxs to suit
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set wbDst = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wbSrc = ThisWorkbook
wsDst = "Sheet1" 'change to suit. Paste sheet
wsSrc = "Sheet1" 'change to suit. Copy sheet
wbDst.Sheets(wsDst).Rows(4).Value = wbSrc.Sheets(wsSrc).Rows(4).Value
wbDst.Sheets(wsDst).Rows(6).Value = wbSrc.Sheets(wsSrc).Rows(6).Value
wbDst.Sheets(wsDst).Rows(10).Value = wbSrc.Sheets(wsSrc).Rows(10).Value
wbDst.Close True
strFilename = Dir()
Loop
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

This will open all .xls files in a given folder and paste the rows from the workbook where this code is placed.

Hope this helps

jo15765
04-20-2012, 07:55 AM
@georgiboy

That code did exactly as I needed! Thank you! One question regarding it...if I wanted to delete a header from wb1, wb2 etc and replace with the header from "Master" and the header was an image, how would the code need to be tweaked?

georgiboy
04-20-2012, 11:03 PM
Maybe something like...


Sub CopyRows()
Dim wbDst As Workbook, wbSrc As Workbook
Dim wsSrc As String, wsDst As String
Dim MyPath As String, strFilename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\Demo" 'change to suit. Multiple files
strFilename = Dir(MyPath & "\*.xls", vbNormal) 'change .xls to .xlxs to suit
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set wbDst = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wbSrc = ThisWorkbook
wsDst = "Sheet1" 'change to suit. Paste sheet
wsSrc = "Sheet1" 'change to suit. Copy sheet
'wbDst.Sheets(wsDst).Rows(1).EntireRow.ClearContents 'if the header is text and not an image
wbDst.Sheets(wsDst).Shapes("Picture 1").Delete 'change to suit
wbSrc.Sheets(wsSrc).Shapes("Picture 1").Copy 'change to suit
wbDst.Sheets(wsDst).Paste
wbDst.Sheets(wsDst).Rows(4).Value = wbSrc.Sheets(wsSrc).Rows(4).Value
wbDst.Sheets(wsDst).Rows(6).Value = wbSrc.Sheets(wsSrc).Rows(6).Value
wbDst.Sheets(wsDst).Rows(10).Value = wbSrc.Sheets(wsSrc).Rows(10).Value
wbDst.Close True
strFilename = Dir()
Loop
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Hope this helps

jo15765
04-21-2012, 05:40 AM
Do I have to explicitly list the picture name:


wbDst.Sheets(wsDst).Shapes("Picture 1").Delete 'change to suit


The reason I am asking is I have glanced at several of these and there have been about 6 different picture names. I know I could create an array and have it cycle through the names in the array, but I am fearful that I could still miss one.

georgiboy
04-21-2012, 08:25 AM
This will work if you only have one shape in each worksheet including master...


Sub CopyRows()
Dim wbDst As Workbook, wbSrc As Workbook
Dim wsSrc As String, wsDst As String
Dim MyPath As String, strFilename As String
Dim Shp As Shape, Shp2 As Shape
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\Demo" 'change to suit. Multiple files
strFilename = Dir(MyPath & "\*.xls", vbNormal) 'change .xls to .xlxs to suit
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set wbDst = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wbSrc = ThisWorkbook
wsDst = "Sheet1" 'change to suit. Paste sheet
wsSrc = "Sheet1" 'change to suit. Copy sheet
'wbDst.Sheets(wsDst).Rows(1).EntireRow.ClearContents 'if the header is text and not an image
For Each Shp In wbSrc.Sheets(wsSrc).Shapes
For Each Shp2 In wbDst.Sheets(wsDst).Shapes
Shp2.Delete
Next Shp2
Shp.Copy
wbDst.Sheets(wsDst).Paste
Next Shp
wbDst.Sheets(wsDst).Rows(4).Value = wbSrc.Sheets(wsSrc).Rows(4).Value
wbDst.Sheets(wsDst).Rows(6).Value = wbSrc.Sheets(wsSrc).Rows(6).Value
wbDst.Sheets(wsDst).Rows(10).Value = wbSrc.Sheets(wsSrc).Rows(10).Value
wbDst.Close True
strFilename = Dir()
Loop
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Hope this helps

jo15765
04-21-2012, 05:36 PM
Are pie charts considered shapes? Would the above code affect pie charts?

georgiboy
04-22-2012, 12:56 AM
Not sure I only have access to an iPhone today, you may be better off with the array option.

Bob Phillips
04-23-2012, 12:11 AM
It is in Excel 2010.

jo15765
04-23-2012, 05:59 AM
I went with the array option and it worked perfectly! Thank you for the code and help :)