Copy/Append Worksheets to Main Workbook

[zest1]

I need help with vba to copy 5 rows of each sheet from workbook ?A? to a ?Main? workbook ?B?.

Wb A has between 5-15 sheets (the sheet names and number varies daily) and only 5 rows of data.
Wb B has about 50 sheets and many rows of data. The sheet names in Wb A are found in Wb B.

I?d like to loop through each worksheet in Wb A (except sheet1) and Copy/Append these 5 rows (rows 1-5) to the matching sheet names in Wb-B (in the next available row).

Can someone kindly help me with the code for this?
Thanks in advance for your help!

[acw]

Hi

Try

[vba]
Sub ccc()
With Workbooks("Book2")
For Each ws In .Worksheets
If ws.Name <> "Sheet1" Then
ws.Rows("1:" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Copy Destination:=ThisWorkbook.Sheets(ws.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next ws

End With
End Sub
[/vba]

In this case, the code above is in your "Main" workbook (workbook B). Replace "book2" with the name of your other workbook.


HTH

Tony

[zest1]

Thanks Tony.

I tried the code but get a "runtime error 9 - subscript out of range" error...
here:

ws.Rows("1:" & ws.Cells(Rows.Count, 1)...


Btw, I forgot to ask, is there a way to use a vba coded lookup table to change the worksheet names of Wb A to match Wb B's sheet names? I'm currently doing it manually. There a 1-letter prefix and a 2-digit date suffix (which changes daily) that I'd liket to eliminate from Wb A's sheet names.

for example, to change:
xBC26 (Wb A)
to
BCR (Wb B)

thanks again for your help!

[zest1]

I found this code below by DRJ that is exactly what I?m looking for. It copies a row from the main worksheet to the other sheets in that workbook whose sheet names match the names in column A.

http://www.vbaexpress.com/kb/getarticle.php?kb_id=318

The code needs only a minor change to do the following:

1. loop through each sheet in the Active Wb and read cell A1 of each sheet
2. take the name found in A1 of each sheet, and find the matching sheet in Wb B
3. then copy Row 2 of that sheet (of the Active Wb) into the next empty row of the matching sheet in Wb B
4. then go to the next sheet...

Is this something that anyone can help me with?

I appreciate any help

Option Explicit
Sub DistributeData()
Dim i               As Long
Dim LastRow         As Long
Dim ws              As Worksheet
Dim ErrorLog        As String
    With Sheets("Main")
        LastRow = .Range("A65536").End(xlUp).Row
        For i = 2 To LastRow
            On Error Resume Next
            Set ws = Sheets(.Range("A" & i).Text)
            On Error GoTo 0
            If ws Is Nothing Then
                ErrorLog = ErrorLog & vbNewLine & _
                "Row:" & i & " Sheet Name: " & .Range("A" & i).Text
            Else
                .Range("A" & i).EntireRow.Copy _
                Destination:=ws.Range("A65536").End(xlUp).Offset(1, 0)
            End If
            Set ws = Nothing
        Next i
    End With
 
    If ErrorLog <> "" Then
        ErrorLog = "The following worksheets could not be found " & _
        "and the data was not transfered over." & vbNewLine & vbNewLine & ErrorLog
        MsgBox ErrorLog
    End If
 
    Set ws = Nothing
 
End Sub

[SamT]

This should Get the Sheet names to where you want.
[VBA]
PseudoCode ChangeSheetNames()
Dim Vars
For each ws in Book1
ws.Name = MID(ws.Name, 2, LEN(ws.Name) - 2))
Next ws
End PseudoCode


[/VBA]

And something like this For the Copy
[VBA]
PseudoCode Append_5_Rows()
'Assumes book1 always has only 5 rows of Data
'Assumes Book2.Sheet(ws).Column(A) is always = longest column in ws
For Each ws in Book1
ws.Range(1:1, 5:5).Copy
Book2.ws.Range("A" & LastRow).PasteSpecial(xlPasteValues)
Next ws
End PseudoCode


[/VBA]

[acw]

Zest

1) If your workbooks have been saved, then you will have to include the .xls suffix to the file name.

2) Yes you could make that sort of change, as long as you know which sheet you want to change to what name. Is the table going to be on a sheet somewhere, or is there some method of translating the data to the code.


Tony

[zest1]

Tony and Sam,
thanks for the advice, but I'm not quite following you.

Could one of you explain a bit more precisely what I need to include in the code (I'm not a vba pro, yet at least)

Thanks!

[acw]

Zest

I guess you are referring to the change of sheet name question.

You have given an example of xBC26 will convert to BCR. Sam has shown how to get the BC component, but how will the progam know that the suffix to add to match the other file will be R??? If there is a conversion table, then were is it. If there is an algorithm to determine the trailing character(s), then what is it?


Tony

[zest1]

Tony,
I solved the sheet name problem with the code below. Each sheet name (of the active wb) shows up in A1 without the extra unwanted characters.

But I'm not sure how to incorporate it into DRJ's "Distribute Data" code that I posted several posts ago. It would be great if I could get some assistance with that.

    ActiveCell.FormulaR1C1 = _
        "=MID(CELL(""filename"",RC[-1]),FIND(""]"",CELL(""filename"",RC[-1]))+1,256)"
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "=IF(LEN(RC[1])=5,MID(RC[1],2,2),MID(RC[1],2,3))"
    Range("A1").Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Range("B1").Clear

(just a reminder, I only need Row 2 of each sheet copied to the matching sheet in the other workbook)

Thanks!

[acw]

Zest1

Try

[vba]
Sub ccc()
With Workbooks("Book2")
For Each ws In .Worksheets
If ws.Name <> "Sheet1" Then
ws.Rows("2:2").Copy Destination:=ThisWorkbook.Sheets(ws.Range("a1").Value).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next ws

End With
end sub
[/vba]


Tony

[SamT]

Oops! there's an error in mine.
Range(1:1, 5:5) won't get it.

SamT

[zest1]

Thanks Tony.

I tried running your code but get a an error - "runtime error 9, subscript out of range" at this point:

With Workbooks("Book2")

I get the error regardless if I include the entire file path in place of "Book2" or just the filename intself. And, with the target workbook open, it errors here:

ws.Rows("2:2").Copy Destination:=ThisWorkbook...

Is there something I'm forgetting?

[acw]

Zest1

What are the full names of the 2 files you are using. Which file will have the macro and which file is the output file.


Tony

[zest1]

Source file (copy from) = "DAILY"
Target file (copy to) = "MAIN"

The code will reside in (and be run from) the "DAILY" file.

The goal is to copy Row 2 of each sheet from DAILY to the MATCHING sheet in MAIN (in the next available row).

Again, cell A1 of each sheet in the DAILY file contains that sheet's name, to be used to find the matching sheet in the MAIN file.

Thanks!

[acw]

Zest1

Try

[VBA]
Sub ccc()
Set OutFile = Workbooks("main.xls")
For Each ws In Worksheets
ws.Range("2:2").Copy Destination:=OutFile.Sheets(ws.Range("a1").Value).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next ws
End Sub
[/VBA]

Both workbooks have to be open and you have to be in daily.xls when you run the code. It does not check to make sure the sheet exists in main.xls so if the sheet does not exist, it will error.


Tony

[zest1]

That did IT!

I included a simple error handler, but I'll explore a more specific one that alerts me as to which sheet was not copied in case of error.

Anyway, I really appreciate your help on this Tony