Excel XP Loop thru sheets

[vaneagle]

Hi All,

I need to loop through sheets in a workbook to copy out a range of data. I have posted some code below. My issue is that it is not moving onto the next sheet to copy the data.

Sub getdata()
Dim wb As Workbook
Dim TheFile As String
Dim MyPath As String
Dim ws As Worksheet

MyPath = "U:\My Documents\Testing\data\"
ChDir MyPath
TheFile = Dir("*.xls")
Do While TheFile <> ""
Set wb = Workbooks.Open(MyPath & "\" & TheFile)

    For Each ws In ActiveWorkbook.Worksheets
        nrow = LastRow("A")
        Range("a1:G" & nrow).Select
        Selection.Copy
    
    Next ws
  wb.Close
  TheFile = Dir
Loop
End Sub

Am I missing something? Am I missing a reference?

vaneagle

 

[PHV]

You may have to insert this line before the call to LastRow:
ws.Activate

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[SkipVought]

Hi,

I would suggest NOT activating each sheet as this adds processing overhead, although, since you are using a function call that has no reference to a sheet, you are stuck with activating.

You are using the COPY method, but where are you pasteing?

Set wb = Workbooks.Open(MyPath & "\" & TheFile)
   'ActiveWorkbook happens to be wb -- use wb
    For Each ws In wb.Worksheets
      'your LastRow function needs a worksheet argument like LastRow(ws.name, "A")
        nrow = LastRow("A")
        ws.Range("a1:G" & nrow).Copy
       'where is the paste???
    Next ws
  wb.Close
  TheFile = Dir
Loop

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[vaneagle]

Hi Skip,

I have made some changes to the code. I hadn't put the pasting side of the code in as I was wanting to make sure that the code was looping through the sheets. I still have the same issue. The code opens the file up, and I goto the first sheet in the workbook. No problems. The first sheet works fine and copies and pastes the data...but it does not goto the second and subsequent sheets in the workbook.. it just loops over the same sheet...

Is there a better way to go?

Option Explicit

Function LastRow(Column As String) As Long
  LastRow = ActiveSheet.Range(Column & "65536").End(xlUp).Row
End Function

Sub AllFolderFiles()
Dim wb, wb2 As Workbook
Dim TheFile, MyPath, sname, Shname, nrow As String
Dim ws As Worksheet
Dim count, counttot As Long
Dim lngSheetCount, numsheets As Long

Set wb = ThisWorkbook

MyPath = "U:\My Documents\Testing\data\"
ChDir MyPath
TheFile = Dir(MyPath & "\*.xls")
Do While TheFile <> ""
    Workbooks.Open Filename:=TheFile, UpdateLinks:=0, ReadOnly:=True
    Set wb2 = ActiveWorkbook

    sname = wb2.Sheets(1).Name
    Sheets(sname).Select
        'retreive sheet names
        For Each ws In wb2.Worksheets
        'your LastRow function needs a worksheet argument like LastRow(ws.name, "A")
        nrow = LastRow("A")
        ws.Range("a1:G" & nrow).Copy
        wb.Activate
        Sheets("data").Select
        nrow = LastRow("B")
        nrow = nrow + 1
        Range("b" & nrow).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        wb2.Activate
        
        Next ws
  
  wb.Close
  TheFile = Dir
Loop
End Sub

vaneagle