Copy and paste rows from one workbook to another skipping rows with a 0 (zero) in column C

[Riptake]

Hi everyone,

I'm a little new to VBA. Wanted to know if there is an easy to learn and customize VBA syntax that can serve my purpose. My task involves copying and pasting (as formatted values - color, decimal etc.) from one workbook to another based on the following criteria. For simplicity, lets assume the source workbook is called "Source" and info is in a tab called "Sheet 1". The output will be generated in a workbook called "Output", in a tab called "Report". The criterion are as follows:

1. If the displayed value in column C in the "Sheet 1" tab is a 0, the corresponding row will be skipped and the next row will be copied.
2. Only columns with matching column headers (in row 1 in both sheets) match, the corresponding data will be copied.


Any direction would be much appreciated.


Thanks

 

[farmerscott]

Riptake,

With point 1, what happens if a 0 follows another 0. Do you still keep ignoring them?
With point 2, which columns have to match? What are their headers?

FarmerScott

 

[Riptake]

Farmerscotts,

Thank you very much for the reply. Apologies for not clarifying. Please see below:

1. Yes, all rows with a 0 will be ignored. Also forgot to mention, the data in the source document is linked to other workbooks and contains formulas. And hence the 0 which is basically blanks in other sheets. Not sure if that will be an issue.

2. For simplicity, the headers in the source sheet are as follows:

LABEL 1 | LABEL 2 | LABEL 3| (Blank Column) | LABEL 4 | LABEL 5 | LABEL 6 | LABEL 7 | (Blank Column) | LABEL 8 |

Headers in the output sheet are as follows:

LABEL 1 | LABEL 2 | LABEL 5| LABEL 4 | LABEL 6


Thanks.

 

[Riptake]

Farmerscott,

Using a version of this Syntax. The only issue I have now is that all rows from the source are being copied. Would it be possible to do a match syntax to only bring in those specific values?

Sub Copy_Rows()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim Lastrow As Long, Nextrow As Long

Set ws1 = Sheets("PL Combined") ' Source worksheet
Set ws2 = Sheets("Report") ' Destination worksheet

' Last used row on source sheet
Lastrow = ws1.Cells.Find("*", , , , xlByRows, xlPrevious).Row


' Next available row on destination sheet
Nextrow = 8

Application.ScreenUpdating = False

' Filter source on column C
ws1.Cells.AutoFilter Field:=3, Criteria1:=">=1" ' Filter column D for values greater than 1

' Copy filtered rows from source to next available row on destination
ws1.Range("A8:AP" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=ws2.Range("A" & Nextrow)

' Clear filter
ws1.AutoFilterMode = False

Application.ScreenUpdating = True

End Sub

 

[Riptake]

Ok. So here is the final code. The section that says "To be edited" can definitely be improved. Any suggestions would be much appreciated.


Sub Copy_Rows()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim Lastrow As Long, Nextrow As Long
Dim Rng As Range

Set ws1 = Sheets("PL Combined") ' Source worksheet
Set ws2 = Sheets("Report") ' Destination worksheet

' Clear Report sheet
Sheets("Report").Range("A8:AP3000").Select
Selection.Delete

' Last used row on source sheet
Lastrow = ws1.Cells.Find("*", , , , xlByRows, xlPrevious).Row

' Next available row on destination sheet
Nextrow = 8

Application.ScreenUpdating = False

' Filter source on column C
ws1.Cells.AutoFilter Field:=3, Criteria1:=">=1"

' Copy filtered rows from source to next available row on destination
ws1.Range("A8:AP" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=ws2.Range("A" & Nextrow)

' To be edited
ws2.Activate
ws2.Columns("AM:AO").Select
Selection.Copy
Range("L1").Select
ActiveSheet.Paste
ws2.Columns("AP").Select
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
ws2.Columns("AM:AP").Select
Selection.Delete

' Clear filter
ws1.AutoFilterMode = False

ws2.Activate
ws2.Cells(1, 1).Select

Application.ScreenUpdating = True

End Sub

 

[farmerscott]

Riptake,

try this on a copy of your data. I don't think it is perfect but it gets us going in the right direction.


Put this in a module of your "Source" workbook.

Sub copy_to_new_sheet()
Dim x As Integer
Dim lr As Integer
Dim wbk1 As Workbook
Dim wbk2 As Workbook

Set wbk1 = Workbooks("Source.xlsm")
Set wbk2 = Workbooks("Output.xlsx")

wbk1.Worksheets("Sheet1").UsedRange.copy Destination:=wbk2.Worksheets("Results").Range("A1")
lr = wbk2.Worksheets("Results").Cells(Rows.Count, "C").End(xlUp).Row

With wbk2.Worksheets("Results")
For x = 1 To lr
If Cells(x, 3) = "0" Then
Rows(x).EntireRow.Delete


End If
Next x
Columns("H:J").EntireColumn.Delete
Columns("C:D").EntireColumn.Delete

End With
End Sub

Hope that helps,

FarmerScott

 

[Riptake]

Hi Farmerscott,


This works great! Always nice to have a separate alternative. However, for my purposes, I was trying to keep the Output file as the .xslm. Sorry by the source file is massive and trying to keep its size down as much as possible. However, appreciate the input. Thank you very much!!


-Riptake

Riptake,

try this on a copy of your data. I don't think it is perfect but it gets us going in the right direction.


Put this in a module of your "Source" workbook.

Sub copy_to_new_sheet()
Dim x As Integer
Dim lr As Integer
Dim wbk1 As Workbook
Dim wbk2 As Workbook

Set wbk1 = Workbooks("Source.xlsm")
Set wbk2 = Workbooks("Output.xlsx")

wbk1.Worksheets("Sheet1").UsedRange.copy Destination:=wbk2.Worksheets("Results").Range("A1")
lr = wbk2.Worksheets("Results").Cells(Rows.Count, "C").End(xlUp).Row

With wbk2.Worksheets("Results")
For x = 1 To lr
If Cells(x, 3) = "0" Then
Rows(x).EntireRow.Delete


End If
Next x
Columns("H:J").EntireColumn.Delete
Columns("C:D").EntireColumn.Delete

End With
End Sub

Hope that helps,

FarmerScott

 

[Riptake]

Sorry I spoke to soon. Some weird is happening after the macro is run and I cant seem to figure out why. The Output and Results seems to switch over at end. I have a sample file but not sure how I can send over.

 

[farmerscott]

Riptake,

I just did a very minor tweak to the code so you can put it in the module of the "Output" workbook. The code will allow you to save the "Source" workbook as a normal excel file (xlsx) and the 'Output" workbook as a macro file (xlsm).

Sub copy_to_workbook()Dim x As Integer
Dim lr As Integer
Dim wbk1 As Workbook
Dim wbk2 As Workbook
' change xlsm to xlsx for "Source" file if necessary.
Set wbk1 = Workbooks("Source.xlsx")
Set wbk2 = Workbooks("Output.xlsm")

wbk1.Worksheets("Sheet1").UsedRange.copy Destination:=wbk2.Worksheets("Results").Range("A1")
lr = wbk2.Worksheets("Results").Cells(Rows.Count, "C").End(xlUp).Row

With wbk2.Worksheets("Results")
For x = 1 To lr
If Cells(x, 3) = "0" Then
Rows(x).EntireRow.Delete
 

End If
Next x
Columns("H:J").EntireColumn.Delete
Columns("C:D").EntireColumn.Delete

End With
End Sub

Can you give a more detailed description of what happened after the code ran.....

FarmerScott

 

[Riptake]

Farmerscott,

When I ran the macro before your prior post, the information in the Output Workbook got copied and pasted the information in the Source Workbook. With the current posting, the macro works fine. The only additional option I would like is for the macro to first check that the headers in the Source and Output work books match and then check to see if there is a "0" in column C in the Source workbook. After both conditions are matched, then the info. transferred over.


Thank you very much,

Riptake