PDA

View Full Version : Copy/Append Worksheets to Main Workbook



zest1
10-26-2006, 05:55 PM
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
10-26-2006, 10:23 PM
Hi

Try


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


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
10-27-2006, 12:09 AM
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
10-27-2006, 08:01 PM
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
10-28-2006, 07:48 AM
This should Get the Sheet names to where you want.

PseudoCode ChangeSheetNames()
Dim Vars
For each ws in Book1
ws.Name = MID(ws.Name, 2, LEN(ws.Name) - 2))
Next ws
End PseudoCode




And something like this For the Copy

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

acw
10-29-2006, 03:48 PM
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
10-30-2006, 08:02 PM
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) :think:

Thanks!

acw
10-30-2006, 08:18 PM
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
10-30-2006, 10:42 PM
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
11-01-2006, 03:46 PM
Zest1

Try


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



Tony

SamT
11-01-2006, 06:31 PM
Oops! there's an error in mine.
Range(1:1, 5:5) won't get it.

SamT

zest1
11-01-2006, 06:56 PM
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
11-01-2006, 08:33 PM
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
11-01-2006, 09:14 PM
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
11-01-2006, 11:13 PM
Zest1

Try


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


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
11-02-2006, 10:45 AM
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 :) :)