Hi Folks,
Total newbie here with VBA.
Basically, I'm looking to copy rows (that meet 2 criteria under a same column header) from one sheet ("Source") to the first empty row in a second spreadsheet ("Target") in the same workbook. I have added the sample spreadsheet (linked below from dropbox) so you can visualize it. I think it can be done with autofilter and then copying and pasting to the other spreadsheet. But not sure how.
Both sheets have the same headers (Method, Type, Booking Date, Days to Trip, Cost).
However, the source headers are in the range B6 to F6 while the target headers are in the range A1 to E1.
Again, this is just a small sample. The real data set is massive but this example illustrates the problem well. I need a macro to copy rows from Source that have the following criteria: either leisure or business under column 2 (ie, type).
Mind you, the example shows source sheet with only 6 rows beneath the header. In reality, the amount of rows in the source changes daily (ie, dynamic) because it's generated by input formulas (you won't see these formulas in my sample spreadsheet but they're unecessary). Initially, when I tried to copy to the target, I realized Excel didn't actually paste to the NEXT EMPTY ROW because it considered blank cells often times to be NON EMPTY (because they contain formulas that generate zero values, and, as such, cannot be technically considered empty). Hence, as I ran my initial macro, the first paste was fine (ie, next empty row), but the row pastings thereafter (ie, additional executions of the macro) generated huge gaps between the old and new chunks of rows posted to the target sheet because Excel doesn't equate blank cells (resulting from " " results) as empty cells.
The workaround I found was to set up a conditional in the generating of the rows in the source sheet, whereby rows that are empty generate "EMPTY" readings. This allowed me to paste to TARGET the whole set of rows and add a final command to delete all rows that were called EMPTY. This works. The problem is the macro takes time to run and crashes every now and then.
I've spent hours on this to no avail.
Much appreciate the help!
Sub CopyPasteRowstoNextEmptyRow()
Dim lastCol As Long, lastRow As Long
With Sheets("Source")
lastCol = .Cells(7, .Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
.Range("B6", .Cells(lastRow, lastCol)).Copy
End With
With Sheets("RegistroTotal")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If lastRow = 1 And .Cells(1) = "" Then lastRow = 0
.Cells(lastRow + 1, "A").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
Dim ws As Worksheet
Dim rng As Range
Dim LR As Long
Set ws = ActiveWorkbook.Sheets("RegistroTotal")
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("A1:A" & LR)
' filter and delete all but header row
With rng
.AutoFilter Field:=1, Criteria1:="EMPTY"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
' turn off the filters
ws.AutoFilterMode = False
End Sub
Heres the example of the spreadsheet.
https://www.dropbox.com/s/jnj34wfbp6sr8dr/Example.xlsx?dl=0
Phil
Total newbie here with VBA.
Basically, I'm looking to copy rows (that meet 2 criteria under a same column header) from one sheet ("Source") to the first empty row in a second spreadsheet ("Target") in the same workbook. I have added the sample spreadsheet (linked below from dropbox) so you can visualize it. I think it can be done with autofilter and then copying and pasting to the other spreadsheet. But not sure how.
Both sheets have the same headers (Method, Type, Booking Date, Days to Trip, Cost).
However, the source headers are in the range B6 to F6 while the target headers are in the range A1 to E1.
Again, this is just a small sample. The real data set is massive but this example illustrates the problem well. I need a macro to copy rows from Source that have the following criteria: either leisure or business under column 2 (ie, type).
Mind you, the example shows source sheet with only 6 rows beneath the header. In reality, the amount of rows in the source changes daily (ie, dynamic) because it's generated by input formulas (you won't see these formulas in my sample spreadsheet but they're unecessary). Initially, when I tried to copy to the target, I realized Excel didn't actually paste to the NEXT EMPTY ROW because it considered blank cells often times to be NON EMPTY (because they contain formulas that generate zero values, and, as such, cannot be technically considered empty). Hence, as I ran my initial macro, the first paste was fine (ie, next empty row), but the row pastings thereafter (ie, additional executions of the macro) generated huge gaps between the old and new chunks of rows posted to the target sheet because Excel doesn't equate blank cells (resulting from " " results) as empty cells.
The workaround I found was to set up a conditional in the generating of the rows in the source sheet, whereby rows that are empty generate "EMPTY" readings. This allowed me to paste to TARGET the whole set of rows and add a final command to delete all rows that were called EMPTY. This works. The problem is the macro takes time to run and crashes every now and then.
I've spent hours on this to no avail.
Much appreciate the help!
Sub CopyPasteRowstoNextEmptyRow()
Dim lastCol As Long, lastRow As Long
With Sheets("Source")
lastCol = .Cells(7, .Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
.Range("B6", .Cells(lastRow, lastCol)).Copy
End With
With Sheets("RegistroTotal")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If lastRow = 1 And .Cells(1) = "" Then lastRow = 0
.Cells(lastRow + 1, "A").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
Dim ws As Worksheet
Dim rng As Range
Dim LR As Long
Set ws = ActiveWorkbook.Sheets("RegistroTotal")
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("A1:A" & LR)
' filter and delete all but header row
With rng
.AutoFilter Field:=1, Criteria1:="EMPTY"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
' turn off the filters
ws.AutoFilterMode = False
End Sub
Heres the example of the spreadsheet.
https://www.dropbox.com/s/jnj34wfbp6sr8dr/Example.xlsx?dl=0
Phil
