Copy from worksheet to worksheet in different workbooks with IF condition

[dcssb01]

Hi,

I am trying to copy a range in a row from 1 worksheet to another in different workbooks with a "IF" condition in column "A", e.g.

IF column "A" equals "H" then copy from range: "B" to "DJ" from test.xls/worksheet1 to "A1" in test1.xls/worksheet1
else IF column "A" equals "D" then copy from range: "B" to "C" from test.xls/worksheet1 to "A1" in test1.xls/worksheet1

I only managed to copy the the first range over to test1.xls/worksheet1, but tried several conditional methods to do the second range. I can't seem to do it.

Code:


Sub OpenAndCopy()
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim rngCopy As Range
Dim wbPaste As Workbook
Dim wsPaste As Worksheet
Dim rngPaste As Range
Dim lRow As Long
Dim lCol As Long

Set wbCopy = Workbooks.Open("C:\TEMP\TEST.XLS") 'change path
Set wsCopy = wbCopy.Worksheets("Sheet1")
lRow = Cells(Rows.Count, 1).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
Set rngCopy = wsCopy.Range("B:K")

Set wbPaste = Workbooks("TEST1.XLS")
Set wsPaste = wbPaste.Worksheets("Sheet1") 'paste to different sheet?
Set rngPaste = wsPaste.Range("A1") 'change this if needed

rngCopy.Copy
rngPaste.PasteSpecial
wbCopy.Close

End Sub


Appreciate whatever assistance I can get to insert the correct VBA to do that. Thanks very much.

[mancubus]

welcome to the forum


?


Sub vbax_62890O_copy_from_closed_wb()

Dim wbCopy As Workbook, wbPaste As Workbook
Dim wsCopy As Worksheet, wsPaste As Worksheet
Dim i As Long, hCols As Long, dCols As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With


On Error Resume Next
Set wbCopy = Workbooks("TEST.XLS")
If wbCopy Is Nothing Then Set wbCopy = Workbooks.Open("C:\TEMP\TEST.XLS") 'change path
Set wsCopy = wbCopy.Worksheets("Sheet1")

Set wbPaste = Workbooks("TEST1.XLS")
If wbPaste Is Nothing Then Set wbPaste = Workbooks("TEST1.XLS")
Set wsPaste = wbPaste.Worksheets("Sheet1")
On Error GoTo 0

hCols = 114
dCols = 2

With wsCopy
For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Range("A" & i).Value = "H" Then
wsPaste.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, hCols).Value = .Range("B" & i & ":BK" & i).Value
ElseIf .Range("A" & i).Value = "D" Then
wsPaste.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, dCols).Value = .Range("B" & i & ":C" & i).Value
Else
'do nothing
End If
Next i
End With

wbCopy.Close False
wbPaste.Save

With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With

End Sub

[dcssb01]

mancubus,

thank you very much for providing your code... I tried it out, and found that dCols = 2 columns, but found that blank cells after column C were also copied over. This is shown when I saved or exported the data to a .csv file, and found the "," separators were extended more than 2 columns. I also found that the formats copied over were not the same as the worksheet copied from. The date cell in test.xls/worksheet1 is "yyyymmdd", but in test1.l/worksheet it became "mmddyyyy".

The first line in the worksheet pasted shows a blank row, also... well perhaps I will add a code to remove blank rows to your code, to remove it then.

Appreciate it very much, if I can get the code to resolve it. My code copied the same in dCols also - blank cells also copied over.

[mancubus]

first, need to correct these:
1)
.Range("B" & i & ":BK" & i).Value
change ":BK" to ": DK".

2)
change
If wbPaste Is Nothing Then Set wbPaste = Workbooks("TEST1.XLS")
to
If wbPaste Is Nothing Then Set wbPaste = Workbooks.Open("C:\TEMP\TEST1.XLS")


your table contains values in column DK
so DK is included in the code.

if the value in column A is "D", the code writes col B and col C values to paste sheet.
perhaps there are already values in some cells.
i added a line to clear the data in the paste sheet first

to keep the cells' formats, i used copy-paste instead of read-write.


Sub vbax_62890O_copy_from_closed_wb()

Dim wbCopy As Workbook, wbPaste As Workbook
Dim wsCopy As Worksheet, wsPaste As Worksheet
Dim i As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

On Error Resume Next
Set wbCopy = Workbooks("TEST.XLS")
If wbCopy Is Nothing Then Set wbCopy = Workbooks.Open("C:\TEMP\TEST.XLS")
Set wsCopy = wbCopy.Worksheets("Sheet1")

Set wbPaste = Workbooks("TEST1.XLS")
If wbPaste Is Nothing Then Set wbPaste = Workbooks.Open("C:\TEMP\TEST1.XLS")
Set wsPaste = wbPaste.Worksheets("Sheet1")
On Error GoTo 0

wsPaste.Cells.Clear

With wsCopy
For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Range("A" & i).Value = "H" Then
.Range("B" & i & ":DK" & i).Copy
wsPaste.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
ElseIf .Range("A" & i).Value = "D" Then
.Range("B" & i & ":C" & i).Copy
wsPaste.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
End If
Next i
End With

wbCopy.Close False
wbPaste.Save

With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With

End Sub

[dcssb01]

Thank you for the amended code.

I have done the changes from ":BK" to ":DK" already before I run your code.

I checked the source file "TEST.XLS" prior to copying rows to "TEST1.XLS" - I exported "TEST.XLS" into "TEST.TXT" file, and I don't know why there are blank cells being exported also. What I was trying to do was to exclude the blank cells being copied & paste into "TEST1.XLS" when column A = "D" in "TEST.XLS". But, so far, I cannot get this done, and that is why I am asking whether it is possible to only copy "B:C" columns only to "TEST1.XLS" where column A = "D" - using End(xlUP) could not do this.

Appreciate it very much whether it is a possible code to get this done, limiting only to copy "B:C" columns only to "TEST1.XLS" where column A = "D" for all rows. Noticed that the last row only copied "B:C" in "TEST1.XLS" when exported to "TEST1.TXT".

Thanks very much for your comments and assistance. Help me understand the codes much better.

[dcssb01]

Don't know why when I put DK an imoji was inserted, as what you can see in the above comment. *Sign*

[mancubus]

you may try copying the D's to another sheet.
H's are 114 columns data whereas D's are 2 columns

when you copy an H to, for example, row 6 and a D to row 7, there will be 112 blank cells at row 7.