0

I have a file named vegetables_fruits and 4 other files : apple, banana, tomato, cucumber. In the file vegetables_fruits I have a Worksheet named List where I fold the names of all 4 files (ex., cell A2 = apple, cell A3 = banana, cell A4 = tomato, cell A5 = cucumber). In addition to the sheet List I have sheets banana, tomato and cucumber, but I don't have apple.

It's necessary to paste the column A from each of this 4 files to every sheet in the vegetables_fruits (ex., from file apple it's necessary to copy column A to file "vegetables_fruits" to sheet "banane" ; from file "banana" it's necessary to copy column A to file vegetables_fruits to sheet tomato etc.) Thank you very much for your help!

P.S. It needs to create a For, but I don't know how I can decribe all of this conditions.

Sub CopyPaste()

Dim r As Variant
Dim a As Variant
Dim b As Integer
Dim nbcells As Integer
Dim ws As Worksheet

Worksheets("List").Activate
nbcells = Application.WorksheetFunction.CountA(Range("A2:A" & Range("A65536").End(xlUp).Row))

' === Create a new sheet ===
For r = 2 To nbcells
    Sheets.Add After:=Sheets(Sheets.Count - 1)
    Worksheets(r).Name = Worksheets("List").Cells(r + 1, 1).Value
Next r

' === DATA ===
For Each ws In Sheets
    If ws.Name Like "*.xls*" Then
        For a = 2 To nbcells
                    Windows(a).Activate
                    Range("B:B").SpecialCells(2).Copy
                    Workbooks("vegetables_fruits.xlsm").Activate
                        b = a + 1
                        If ws.Name = Worksheets("List").Cells(b, 1).Value Then
                            ws.Select
                            Range("A2").Select
                            ActiveSheet.Paste
                        End If
                Next a
    End If
Next

End Sub
Maria
  • 69
  • 1
  • 10
  • `For Each ws In Sheets` do the same thing with workbooks. Edit: `for each wb in application.workbooks`. – findwindow Apr 21 '16 at 14:50
  • What do you think? I am not going to spoon feed you. Please put in some effort. – findwindow Apr 21 '16 at 14:52
  • The result is not correct. Two first sheets "banana" and "tomato" have the same values. – Maria Apr 21 '16 at 14:57
  • 1
    Great. So start debugging. Edit: hint - don't use `activate` and `select`. Create objects for your sheets/books. – findwindow Apr 21 '16 at 14:58
  • It's **highly** suggested you avoid using `.Select` and `.Activate` as this can cause issues down the line. Read through [this thread](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) and apply what you learn. It will also help you learn VBA in general. – BruceWayne Apr 21 '16 at 15:10

1 Answers1

0

Maria - Reading your question, I think the additional logic you need is as follows:

  1. Assume all workbooks are open, and have the appropriate name.
  2. Loop through all of the workbooks.
  3. If I find a workbook with one of my defined names, then copy Column A from (some sheet) in that workbook
  4. Paste this into the master workbook, on the sheet with the corresponding name.

For my example, you would need to add these variables in the section where the variables are declared.

Dim fromWS As Worksheet, toWS As Worksheet
Dim wb As Workbook, myWB As Workbook

Early in the code, near the top, you will need this line of code.

Set myWB = ActiveWorkbook

Later in the code, this Loop and Case statements will accomplish the above logic ...

For Each wb In Workbooks
    Select Case wb.Name
        Case "apple"
            Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
            Set toWS = myWB.Worksheets("apple")
        Case "banana"
            Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
            Set toWS = myWB.Worksheets("banana")
        Case "tomato"
            Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
            Set toWS = myWB.Worksheets("tomato")
        Case "cucumber"
            Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
            Set toWS = myWB.Worksheets("cucumber")
        Case Else
    End Select
    fromWS.Range("A:A").Copy toWS.Range("A:A")
Next wb

You talk about there not being an "apple" sheet. This is a nuance you may need to build exception logic for. (e.g. just omit that case in the above loop)

OldUgly
  • 2,129
  • 3
  • 13
  • 21