Correction to original

[Jamuson]

I have a macro that works for the first instance of pasting into the new sheet. The problem is that when I offset the second sheet, I can't get both the ValuesAndNumberFormat and Format to "line up". Heres what I have...Im going to repeat the operation on 8 sheets total, to combine them into one with the original formatting...Im sure there is a way to Loop it to run through all the sheets and never paste over data, plus keep all the formatting.

Sub Data_Scrubber()

Dim count_col, count_row As Integer
Dim orig, output As Worksheet

Worksheets("Sheet1").Activate

Set orig = ThisWorkbook.Sheets("Sheet1")
Set output = ThisWorkbook.Sheets("Corrections")

count_col = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlToRight)))
count_row = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlDown)))

ActiveSheet.Range("A2").AutoFilter Field:=1, Criteria1:="<>"

orig.Range(Cells(2, 1), Cells(count_row, count_col)).SpecialCells(xlCellTypeVisible).Copy
output.Cells(2, 1).PasteSpecial xlPasteValuesAndNumberFormats
output.Cells(2, 1).PasteSpecial xlPasteFormats
Application.CutCopyMode = False

Worksheets("Sheet2").Activate

Set orig = ThisWorkbook.Sheets("Sheet2")
Set output = ThisWorkbook.Sheets("Corrections")

count_col = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlToRight)))
count_row = WorksheetFunction.CountA(Range("A2", Range("A2").End(xlDown)))

ActiveSheet.Range("A2").AutoFilter Field:=1, Criteria1:="<>"

orig.Range(Cells(2, 1), Cells(count_row, count_col)).SpecialCells(xlCellTypeVisible).Copy
output.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
output.Cell(2,1)PasteSpecial xlPasteFormats
Application.CutCopyMode = False



End Sub

Any help would be appreciated!

 

[mse330]

Hi Jamuson,

Try below code ... We might need to do some adjustments as I am not sure if you have any data in row #1 of the sheets, does your data extends to more than one column with data, do you have headers in sheet 'Corrections' ... etc. Give it a try & let us know how it goes

Sub test()

Dim ws As Worksheet, MainWs As Worksheet
Set MainWs = Sheets("Corrections")

For Each ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3")) '<-- add sheet names where needed
   With ws.[A2].CurrentRegion
      .AutoFilter 1, "<>"
      .Offset(1).SpecialCells(12).Copy
         With MainWs.Range("A" & Rows.Count).End(3).Offset(1)
            .PasteSpecial xlPasteValuesAndNumberFormats
            .PasteSpecial xlPasteFormats
         End With
      .AutoFilter
   End With
Next

End Sub

 

[Jamuson]

Hi Jamuson,

Try below code ... We might need to do some adjustments as I am not sure if you have any data in row #1 of the sheets, does your data extends to more than one column with data, do you have headers in sheet 'Corrections' ... etc. Give it a try & let us know how it goes

Sub test()

Dim ws As Worksheet, MainWs As Worksheet
Set MainWs = Sheets("Corrections")

For Each ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3")) '<-- add sheet names where needed
   With ws.[A2].CurrentRegion
      .AutoFilter 1, "<>"
      .Offset(1).SpecialCells(12).Copy
         With MainWs.Range("A" & Rows.Count).End(3).Offset(1)
            .PasteSpecial xlPasteValuesAndNumberFormats
            .PasteSpecial xlPasteFormats
         End With
      .AutoFilter
   End With
Next

End Sub

Thanks so much! this worked perfectly!
I have one more function Im trying to work out.
Id like to click on a row in Sheet"MASTER" and run a quick key macro and copy the values from columns R,O and Q and paste them into the next available row on Sheet"CORRECTIONS" in columns A,B,C...Is this even possible?

 

[mse330]

Try below code assuming you'll be in sheet 'MASTER' when running the macro

Sub test()

With Sheets("CORRECTIONS").Range("A" & Rows.Count).End(3)(2).Resize(, 3)
    .Value = Array(Cells(ActiveCell.Row, "R"), Cells(ActiveCell.Row, "O"), Cells(ActiveCell.Row, "Q"))
End With

End Sub

 

[Jamuson]

Again this works amazing! I can't thank you enough. I'm quarantined in Japan away from my family and this helps a ton! Happy holidays to you and your family, stay safe!

Thanks again,

Jamuson

 

[mse330]

Glad to help & thanks for your feedback ... Stay safe