PDA

View Full Version : [SOLVED] Need to copy paste different cells to another file (files are same image)



loveguy1977
09-12-2013, 12:27 PM
Dear, Sir,

I need to copy many cells from file1 and paste it as value to another file2 (mean same table, postion, headers, etc)

Bellow just very simple of my data
File1 is:
A1 to A10 then A11 is sum
A12 to A20 then A21 is sum
A22 is sum of A11 & A21

File2 is same but A11 & A21 & A22 is protected (I can't open it bez it is linked to another program)

I need to copy (A1 to A10) & (A12 to A20) in one go.

Is it possible plz. This way will save my 3 hours time job.

Thank you very much

mrojas
09-12-2013, 01:45 PM
You probably would need to do something similar to this. Open your File1, select the range, copy, open File2 select range, paste.

Sheets(intSheet1).Activate
Range(strColumnFirst & "1:" & strColumnLast & lngLastCell).Select
Selection.Copy
Sheets(intSheet2).Activate
Range(strColumnPaste & 1).Select
ActiveSheet.Paste

loveguy1977
09-12-2013, 02:59 PM
Sorry mrojas,
Your way is very diffcult for me to do the macro for it. I could not understand how to do it

loveguy1977
09-12-2013, 03:51 PM
This code is nice but:

However, below example also is 1% of my ranges which is in different ranges and different columns

Sub Copy_Ranges_From_Source_To_Master()
Dim wb1, wb2 As Workbook
Dim ws1, ws2 As Worksheet
Set wb1 = Workbooks("111.xlsm") 'Source
Set wb2 = Workbooks("222.xlsx") 'Destination
Set ws1 = wb1.Worksheets("Sheet1")
Set ws2 = wb2.Worksheets("Sheet1")
wb1.Activate
ws1.Range("A1:A10 ").Select
Selection.Copy
ws2.Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb1.Activate
ws1.Range("A12:A20").Select
Selection.Copy
ws2.Activate
Range("A12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb1.Activate
ws1.Range("A25:A29").Select
Selection.Copy
ws2.Activate
Range("A25").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb1.Activate
ws1.Range("A70:A88").Select
Selection.Copy
ws2.Activate
Range("A70").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb1.Activate
ws1.Range("A100:A135").Select
Selection.Copy
ws2.Activate
Range("A100").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

BUT if there is row added in the 1st range (i mean A1:A10) then the range that need to be copied will become A1:A11. So I need to modify the vba code as well. Then will another diffecult work to modify the vba code for all the next ranges.

loveguy1977
09-12-2013, 05:22 PM
I got another nice code but need to make it more short. There will more than hunderds named range. These named ranges will be listed down in a column AB1:AB150

AB1: NamedRange
AB2: NamedRange1
AB2: NamedRange2
and so on

I need to use code
For each oCell in Range("AB1:Ab150") then
wb1.Activate
Range("NamedRange")(1).Select
strAddress = ActiveCell.Address
ws1.Range("NamedRange").Copy
ws2.Activate
Range(strAddress).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Next


Sub Copy_Ranges_From_Source_To_Master()
Dim wb1, wb2 As Workbook
Dim ws1, ws2 As Worksheet
Dim strAddress As String
Set wb1 = Workbooks("111.xlsm") 'Source
Set wb2 = Workbooks("222.xlsx") 'Destination
Set ws1 = wb1.Worksheets("Sheet1")
Set ws2 = wb2.Worksheets("Sheet1")
wb1.Activate
Range("NamedRange")(1).Select
strAddress = ActiveCell.Address
ws1.Range("NamedRange").Copy
ws2.Activate
Range(strAddress).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

wb1.Activate
Range("NamedRange1")(1).Select
strAddress = ActiveCell.Address
ws1.Range("NamedRange1").Copy
ws2.Activate
Range(strAddress).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

wb1.Activate
Range("NamedRange2")(1).Select
strAddress = ActiveCell.Address
ws1.Range("NamedRange2").Copy
ws2.Activate
Range(strAddress).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

wb1.Activate
Range("NamedRange3")(1).Select
strAddress = ActiveCell.Address
ws1.Range("NamedRange3").Copy
ws2.Activate
Range(strAddress).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

wb1.Activate
Range("NamedRange4")(1).Select
strAddress = ActiveCell.Address
ws1.Range("NamedRange4").Copy
ws2.Activate
Range(strAddress).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

wb1.Activate
Range("NamedRange5")(1).Select
strAddress = ActiveCell.Address
ws1.Range("NamedRange5").Copy
ws2.Activate
Range(strAddress).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

wb1.Activate
Range("NamedRange6")(1).Select
strAddress = ActiveCell.Address
ws1.Range("NamedRange6").Copy
ws2.Activate
Range(strAddress).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

wb1.Activate
Range("NamedRange7")(1).Select
strAddress = ActiveCell.Address
ws1.Range("NamedRange7").Copy
ws2.Activate
Range(strAddress).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

wb1.Activate
Range("NamedRange8")(1).Select
strAddress = ActiveCell.Address
ws1.Range("NamedRange8").Copy
ws2.Activate
Range(strAddress).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
End Sub

loveguy1977
09-13-2013, 03:50 AM
Dear all,

I got it. Here is below for any one who is interested to use


Sub Copy_Ranges_From_Source_To_Master()
Dim wb1, wb2 As Workbook
Dim ws1, ws2 As Worksheet
Dim strAddress, RngName As String
Dim oCell As Range
Set wb1 = Workbooks("111.xlsm") 'Source
Set wb2 = Workbooks("222.xlsx") 'Destination
Set ws1 = wb1.Worksheets("Sheet1")
Set ws2 = wb2.Worksheets("Sheet1")

For Each oCell In Range("AB1:AB150")
On Error Resume Next
If oCell.Value <> "" Then

wb1.Activate
oCell.Select
RngName = oCell.Text
Application.Goto Reference:=RngName
Range("RngName")(1).Select
strAddress = ActiveCell.Address
Selection.Copy

ws2.Activate
Range(strAddress).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Application.DisplayAlerts = True
End If
Next oCell
End Sub