Alter Code

[vac]

Hi all,
How do I alter the following code to make it do the following:
Copy only columns A:D instead of all row
Search through more than 1 worksheet ie sheet2, sheet3, sheet4 etc

Sub Export()
Sheets("Sheet2").Select
Columns("A").SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Hidden = True
Selection.CurrentRegion.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy Sheets("Sheet1").Range("A1")
Cells.Rows.Hidden = False
Range("A1").Select
End Sub

Many Thanks

 

[erik.van.geit]

Hi,

I think you could use this

Sub Export()
Dim i As Integer

    For i = 2 To Sheets.Count
        With Sheets(i)
        On Error Resume Next
        .Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
        On Error GoTo 0
            With .Range("A1").CurrentRegion
            .Resize(.Rows.Count, 4).SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            End With
        .Cells.Rows.Hidden = False
        Range("A1").Select
        End With
    Next i

End Sub

not sure if you wanted to copy the entire used range (except empty in column A)

kind regards,
Erik

 

[HalfAce]

Here's another option that doesn't require sheet1 to be the left-most tab in your workbook.
(Never know when some user will move things around.)

Sub Export()
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Sheets
  If Ws.Name <> ("Sheet1") Then
    With Ws
      .Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
      With .Columns("A").CurrentRegion
        .Resize(, 4).SpecialCells(xlCellTypeVisible).Copy _
          Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)(2)
      End With
      .Cells.Rows.Hidden = False
    End With
  End If
Next Ws
Sheets("Sheet1").Rows(1).EntireRow.Delete
End Sub

[EDIT:] Forgot to limit it to only 4 columns until I saw Erik's post.

Morning Erik. (or 'evening' for you I suppose.)

 

[vac]

thanks for the reply, but I get an error on the following line
.Resize(.Rows.Count, 4).SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

 

[vac]

Thanks Halface, but I get runtime error 1004, no cells found with debug on this line
.Columns("A").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)(2)

 

[erik.van.geit]

thanks for the reply, but I get an error on the following line
.Resize(.Rows.Count, 4).SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

what's the error message ?
do you have a sheet called "sheet1" ?
does this line produce an error (cut off a part) ?

.Resize(.Rows.Count, 4).SpecialCells(xlCellTypeVisible).Copy

Hi, Dan,

good mornevening it's about 20.30 PM here

 

[HalfAce]

1. Check my post again. I edited it to only copy columns A:D.
2. What's getting duplicated?
There's nothing there to address duplications, just blanks in column A?

 

[HalfAce]

Man, you guys are replying too quickly for me to keep up.
Try this slightly modified code to handle the error if you have no blanks in column A on any sheets.

Sub Export()
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Sheets
  If Ws.Name <> ("Sheet1") Then
    On Error Resume Next
    With Ws
      .Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
      With .Columns("A").CurrentRegion
        .Resize(, 4).SpecialCells(xlCellTypeVisible).Copy _
          Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)(2)
      End With
      .Cells.Rows.Hidden = False
    End With
  Err.Clear
  End If
Next Ws
Sheets("Sheet1").Rows(1).EntireRow.Delete
End Sub

Still don't know what you mean about the duplications though.

 

[vac]

Hi, I get runtime error 1004
with this line
.Resize(, 4).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)(2)

Thanks

 

[vac]

Thanks Halface,
That seems to work OK now. As for the duplications, its me sorry, forgot to delete other data, lol.
And yes the posts were fast for me too, and I was posting lol