Здравейте на всички,
бих искал да попитам дали има някой който може да удари едно рамо за моята задачка?
Имам написан скрипт имам и таблицата но поради факта, че не съм наясно с VBA ми е много трудно да се справя до края на задачката.
Идеята е следната:
Имам екселска таблица със 36 шиита
1-ят се казва Operation
всички останали са наименовани Inv nomer1, Inv nomer2, Inv nomer3 do Inv nomer35.
В Operation - имам 5004 реда на които трябва да пиша.
Писането става от А6 до А5004 но проблемът е следният:
Ще се опитам да дам пример за да ме разберете и да ви объркам:
А6, В6, С6, D6, E6, F6
Inv nomer(някакъв номер напр.24), 23123213, кран, 1бр., 25.00лв., 12.11.2011 г.
Този Inv nomer в колона А6:А5004 го избирам от падащо меню направено с Data Validation, след като го избера срещу всяко А6, А7, А8 -> започвам да пиша неща, дати, бройки и т.н
Сега след като съм написал каквото трябва в началото на таблицата съм направил един бутон в който вкарвам VBA кода и когато го натисна искам на всеки от избраните Inv nomer да си отиде в неговият шиит от например: А6 до F6 и така до там, докъдето съм писал - А7 - F7; A8-F8.

Кодът, който се опитах да направя е:
Option Explicit
Sub send_data()
Dim last_row As Integer
Dim start_row As Integer
Dim wsheet As Worksheet
Dim strSheet As String
Dim strRange As String
Dim dest_row As Integer
Dim i
Application.ScreenUpdating = False
Set wsheet = Worksheets("Operation")
start_row = wsheet.Cells.Find("Sheet's", [A1], , , xlByRows, xlPrevious).Row
last_row = wsheet.Range("A65536").End(xlUp).Row
For i = start_row + 1 To last_row
strRange = ""
wsheet.Range("a" & i & ":F" & i).Copy
If wsheet.Cells(i, 1) <> "" Then
'find the position in matrice and add 1 to send to the good sheet
strRange = "Inv nomer" & WorksheetFunction.Match(Cells(i, 1), Range("J6:J41")) + 1
If Sheets(strRange).Range("A6") <> "" Then
dest_row = Sheets(strRange).Range("A5").End(xlDown).Offset(1, 0).Row
Else
dest_row = 6
End If
Sheets(strRange).Range("A" & dest_row).PasteSpecial Paste:=xlPasteValues
Sheets(strRange).Cells.EntireColumn.AutoFit
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

линк към таблицата - http://dox.bg/files/dw?a=62def26169
След като натисна бутона понякога ми го изпраща, а понякога не иска. И най-важното е че не ми го изпраща в съответният шиит, а където си поиска в останалите шиитове(най-вече в шиит3).
Въпрост сега е, аз ли бъркам някъде или кодът не работи защото не съм го поставил във всички 36 шиита.
Просто не знам как става.
Моля ако някой разбира малко повече отколкото трябва нека помогне.
Ако има нещо което искате да питате съм на линия.
Още веднъж много благодаря предварително.

Според мене не са активирани да търси другите SHEETS.

ето така се активират:

Worksheets(strRange).Activate
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
lastrow = lastrow + 1
Sheets(strRange).Range("A" & lastrow).PasteSpecial Paste:=xlPasteValues

намира последния ред и след него вмъква копирания ред. Работи пробвах го.

Редактирано от lRlKO на 30.09.11 14:46.

Много ти благодаря.
Стана перфектно, поради факта, че не съм много наясно явно съм объркал нещо, но сега е ОК.