Looping sheets and copying from excel in another server. Please help.

[bernice620]

Hi all-

I've been browsing this forum for something like this but I haven't come across something similar to mine. I'd like to loop through all the sheets and find words that matches the excel file on the server, and if it matches then it pulls and copies the "Input" sheet in the excel file that is on the server. My current code pulls in only one file. How do I make it so it loops through all sheets and matches the name? I hope this makes sense.

Sub CopyWIW() 
    
   Dim WS As Worksheet 
   Dim wbTarget            As Workbook 'WIW file 
   Dim wbThis              As Workbook 'Observe report 
   Dim strName             As String   'name of the source sheet/ target workbook 
     
   Set wbThis = ActiveWorkbook 
     
   'get the active sheetname of the book 
   strName = ActiveSheet.Name 
     
   'open a workbook that has same name as the sheet name 
   Set wbTarget = Workbooks.Open("\\ReliabilityEngineering\WarrantyImprovementWorkbooks\" & strName & ".xlsm") 
     
   'select cell A1 on the target book 
   wbTarget.Sheets("Input").Activate 
   Range("A5:Q5" & Cells(Rows.Count, "A").End(xlUp).Row).Copy 
    
   wbThis.Activate 
   'Range("A1").Select 
   Range("A1").PasteSpecial 
    
   'close the workbook 
   wbTarget.Close 
 
   'activate the source book again 
   wbThis.Activate 
     
   'clear memory 
   Set wbTarget = Nothing 
   Set wbThis = Nothing 
     
End Sub  

[rollis13]

These minor changes should do. Now you need to decide how to heap all the data.

Please Login or Register  to view this content.

[bernice620]

It loops through the sheets but it doesn't paste it into the matching sheet. It stays on the same sheet and contines to open a new excel file. What's missing? Below is my revised code. I would like the file ABC that I open to match my worksheet name ABC.

Option Explicit

Sub AddSheets()
Dim SheetCnt As Integer
Dim WS As Worksheet
Dim wbTarget            As Workbook 'WIW file
Dim wbThis              As Workbook 'Observe report
Dim strName             As String   'name of the source sheet/ target workbook

    
    SheetCnt = Worksheets.Count
    
    Sheets.Add After:=Worksheets(SheetCnt)
    ActiveSheet.Name = "RW6000WIW"
    
    Sheets.Add After:=Worksheets(SheetCnt)
    ActiveSheet.Name = "7000MRWIW"
    
    Sheets.Add After:=Worksheets(SheetCnt)
    ActiveSheet.Name = "8000WWIW"
    
    Sheets.Add After:=Worksheets(SheetCnt)
    ActiveSheet.Name = "8000TWIW"
    
    Sheets.Add After:=Worksheets(SheetCnt)
    ActiveSheet.Name = "9000AGWIW"
    
    Sheets.Add After:=Worksheets(SheetCnt)
    ActiveSheet.Name = "9000TWIW"
    
    Sheets.Add After:=Worksheets(SheetCnt)
    ActiveSheet.Name = "9000SCWIW"

       
 Set wbThis = ActiveWorkbook
    
 For Each WS In wbThis.Worksheets        '<== added
      With WS

         If Right(WS.Name, 3) = "WIW" Then
        'get the active sheetname of the book
         strName = WS.Name                       '<== changed
              
        'open a workbook that has same name as the sheet name
        Set wbTarget = Workbooks.Open("\\frxfileserv2\Engrng\ReliabilityEngineering\WarrantyImprovementWorkbooks\" & strName & ".xlsm", ReadOnly:=True)
        
        
        'select cell A1 on the target book
        wbTarget.Sheets("Input").Activate
        Range("A5:Q5" & Cells(Rows.Count, "A").End(xlUp).Row).Copy
             
        wbThis.Activate
        'Range("A1").Select
        Range("A1").PasteSpecial                '<== needs to be changed
             
        'close the workbook
        wbTarget.Close
        End If
   End With
Next WS                                 '<== added
    
'activate the source book again
''wbThis.Activate
      
''clear memory
''Set wbThis = Nothing


End Sub  

[bernice620]

Penny for your thoughts?

[rollis13]

This should do what you are now asking for:

Please Login or Register  to view this content.

[bernice620]

This works great!!! Thanks!!!

[rollis13]

Glad being of some help .