PDA

View Full Version : Copy and Paste from other Workbooks with conditions



ATan
02-15-2009, 11:40 PM
I have a source workbook in ("S:\Infrastructure Section\Commercial Management\PMI and Claims\MBS-11-005a and 005b - Claims Registers Rev. 1-Infrastructure.xls") in a sheet named as "Clause 14". This workbook contains a massive amount of data which for my purpose I only needed only data from a few specific columns (Col A to F, S, T).
The target workbook is found in ("S:\Infrastructure Section\Commercial Management\PMI and Claims\INFRA-EOT Summary.xls") in a sheet named as "WP2047".
I need to extract from the source workbook all the data if column "A" starting from row 10 contain the value of "WP2407". So all rows will column A having the value of "2407" will be extracted to the target but only from the following columns, A to F, S, T starting from row 10. The data coming in from the source file will start at row 7 in the target file. I hope I a clear with what I am trying to get across. Please let me know if you need further clarification.

MaximS
02-16-2009, 01:51 AM
you can use something like that:


Sub Copy_Paste()

Dim wb, wb1 As Workbook
Dim sh, sh1 As Worksheet

Set wb = Workbooks.Open("S:\Infrastructure Section\Commercial Management\" _
& "PMI and Claims\MBS-11-005a and 005b - Claims Registers Rev. 1-Infrastructure.xls")

Set sh = wb.Worksheets("Clause 14")

Set wb1 = Workbooks.Open("S:\Infrastructure Section\Commercial Management\" _
& "PMI and Claims\INFRA-EOT Summary.xls")

Set sh1 = wb1.Worksheets("WP2047")

Dim i, LastRow As Long
Dim strx As String


With sh
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

j = 7

For i = 10 To LastRow
If .Cells(i, 1).Value = "WP2407" Then
strx = sh.Range("A" & i).Value
sh1.Range("A" & j).Value=Mid(strx, 3, 4)
.Range("B" & i & ":F" & i).Copy Destination:= sh1.Range("B" & j & ":F" & j)
.Range("S" & i & ":T" & i).Copy Destination:= sh1.Range("S" & j & ":T" & j)
j = j + 1
End If
Next i
End With

End Sub

ATan
02-16-2009, 02:14 AM
MaximS,

Thanks for the quick reply, I couldn't understand why I encountered an error while running the codes.
This is the error message "Runtime error '9'. Subscript out of range".

MaximS
02-16-2009, 02:22 AM
i've changed the code so try again if it doesn't work copy the line where that error appears.

ATan
02-16-2009, 02:31 AM
MaximS,

Sorry, I did not see the changes you said.

MaximS
02-16-2009, 02:41 AM
copy and paste the code to your worksheet, then run the code again.

the part I have changed is:

from

Set wb = Workbooks(".....")

to

Set wb = Workbooks.Open(".....")

ATan
02-16-2009, 02:56 AM
MaximS,

I have changed the codes as suggested but the same error message still appear but it did not indicate where the error is occurring. Secondly, the source file is opened by the codes.

GTO
02-16-2009, 03:18 AM
MaximS,

I have changed the codes as suggested but the same error message still appear but it did not indicate where the error is occurring. Secondly, the source file is opened by the codes.

Greetings ATan,

Just curious, what workbook did you put Maxim's code in?

Mark

MaximS
02-16-2009, 03:23 AM
have you pressed debug button?? if yes which line is highlighted on yellow.

ATan
02-16-2009, 03:24 AM
In the worksheet called "WP2407" itself as I am running the codes from a button. Does this matter?

I put the codes into a module and the same error message still appear but highlight the error being here


Set wb1 = Workbooks("S:\Infrastructure Section\Commercial Management\" _
& "PMI and Claims\INFRA-EOT Summary.xls")

MaximS
02-16-2009, 03:35 AM
in that case change code to:


Sub Copy_Paste()

Dim wb, wb1 As Workbook
Dim sh, sh1 As Worksheet

Set wb1 = ActiveWorkbook

Set sh1 = wb1.Worksheets("WP2047")

Set wb = Workbooks.Open("S:\Infrastructure Section\Commercial Management\" _
& "PMI and Claims\MBS-11-005a and 005b - Claims Registers Rev. 1-Infrastructure.xls")

Set sh = wb.Worksheets("Clause 14")


Dim i, LastRow As Long
Dim strx As String


With sh
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

j = 7

For i = 10 To LastRow
If .Cells(i, 1).Value = "WP2407" Then
strx = sh.Range("A" & i).Value
sh1.Range("A" & j).Value=Mid(strx, 3, 4)
.Range("B" & i & ":F" & i).Copy Destination:= sh1.Range("B" & j & ":F" & j)
.Range("S" & i & ":T" & i).Copy Destination:= sh1.Range("S" & j & ":T" & j)
j = j + 1
End If
Next i
End With

End Sub


and try again

ATan
02-16-2009, 03:47 AM
MaximS,

With the new codes the error message shows up this part of the code is having the problem.

The codes are in a module.


Set sh1 = wb1.Worksheets("WP2047")

GTO
02-16-2009, 03:49 AM
@Maxims:

Just wanted to say Howdy and forgot to :-)

Mark

ATan
02-16-2009, 03:51 AM
GTO,

Hi! Thanks for dropping into this thread. So far no luck in getting the codes to work the way it suppose to be.

ATan
02-16-2009, 03:56 AM
MaximS,

A Thousand apology. I spotted the error. The Sheet name should be WP2407 instead of WP2047. The code is running but one question. Why is the source workbook open after the data is copied over? How to close it after the data are copied?

MaximS
02-16-2009, 04:01 AM
replace:


Next i
End With


with:


Next i
.Close
End With

ATan
02-16-2009, 09:30 PM
MaximS,

Appreciate very much your help to get this macro working. I have made some minor changes after successfully running the codes. These are the changes made as I wanted to line the data consecutively.


.Range("S" & i & ":T" & i).Copy Destination:= sh1.Range("S" & j & ":T" & j to

.Range("S" & i & ":T" & i).Copy Destination:=sh1.Range("G" & j & ":H" & j)