Alter Code

vac

Board Regular
Joined
May 21, 2002
Messages
211
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
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi,

I think you could use this
Code:
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

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,454
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.)
Code:
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. :rolleyes:

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

vac

Board Regular
Joined
May 21, 2002
Messages
211
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

Board Regular
Joined
May 21, 2002
Messages
211

ADVERTISEMENT

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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
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) ?
Code:
.Resize(.Rows.Count, 4).SpecialCells(xlCellTypeVisible).Copy

Hi, Dan,

good mornevening ;) it's about 20.30 PM here
 

HalfAce

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,454

ADVERTISEMENT

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

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,454
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.
Code:
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

Board Regular
Joined
May 21, 2002
Messages
211
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

Board Regular
Joined
May 21, 2002
Messages
211
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
 

Forum statistics

Threads
1,141,681
Messages
5,707,796
Members
421,529
Latest member
Balintn

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top