большое спасибо ))) ,  
в инете я не смог найти ((((

Можна как то отключить переход на исходную строку после двойного клика на сводной  ?(VBA)  
 
у меня и макрос срабатывает и переносит...

Автор, вопрос поставлен некорректно: например, там нет значений "Корова", "777555"... Много чего нет. И всё это нужно перечислить?  
 
все значение которых нету в листе F (столбик A,B)

спасибо за макрос ) ,    
 
 
почему в первом макросе больше двух не бывает??  
, вот по другому написал з  if not b2 then: end if и работает .  
 
Sub test()  
   
 Dim ws As Worksheet, a, g, f, aLR&, gLR&, i&, j&, flag As Boolean  
   
 Set ws = ThisWorkbook.Worksheets("Ëèñò1")  
 N = 1  
 aLR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row  
 gLR = ws.Cells(ws.Rows.Count, 7).End(xlUp).Row  
 a = ws.Range(ws.[a2], ws.Cells(aLR, 1)).Value
 g = ws.Range(ws.[g2], ws.Cells(gLR, 7)).Value
 ReDim f(1 To gLR - 1, 1 To 1)  
   
 For i = 1 To UBound(g, 1)  
   j = 1: flag = False  
   Do Until flag Or j > UBound(a, 1)  
     If g(i, 1) = a(j, 1) Then  
        flag = True  
     End If  
     j = j + 1  
   Loop  
   If Not flag Then f(i, 1) = g(i, 1): ws.Cells(N, 10) = f(i, 1): N = N + 1  
 Next  
   
End Sub

{quote}{login=KukLP}{date=06.11.2011 06:30}{thema=}{post}А короче:  
If not (Cells(a, 1) = "ee" Or Cells(a, 1) = "as") Then ...?{/post}{/quote}  
 
 
Hugo большое спасибо )))),  
 
 
 
If not (Cells(a, 1) <> "ee" Or Cells(a, 1) <> "as") Then работать не будет ...

{quote}{login=nerv}{date=06.11.2011 05:13}{thema=}{post}RAN, приветствую!  
 
Аноним,  
во-первых: здесь не любят Анонимов (советую подписаться)  
во-вторых: лучше воздержитесь (по возможности) от использования логических операторов, т.к. они сильно "тормозят" программу (в подобных конструкциях){/post}{/quote}  
 
в данном случае мне логические операторы необходимы,  
 
If Cells(a, 1) <> "ee" Or Cells(a, 1) <> "as" Then , такая конструкция не работает , з case таже ситуация

а можно как то объединить 3 цикла while в один ? , структура Файлов одинаковая ...  
 
 
 
Sub test()  
Dim MyPath, MyPath1, mypath3 As String  
   Dim iFileName, iFileName1, ifilename3 As String  
   Dim i, j As Integer  
   Dim wba As Workbook  
   Dim a, stolb As String  
   Dim shets As Worksheet  
   Dim arr() As Integer  
   Dim marr() As Integer  
     
   MyPath = "C:\dr\"  
   iFileName = Dir(MyPath)  
     
   stolb = "a"  
     
   On Error Resume Next  
   Set wba = ThisWorkbook  
   
  While iFileName <> ""  
  For i = 2 To 5  
  If iFileName = wba.Worksheets("3").Cells(i, 1) Then  
    Workbooks.Open (MyPath + iFileName)  
For Each shets In wba.Sheets  
If shets.Name = wba.Worksheets("3").Cells(i, 3) Then  
With ActiveWorkbook.Worksheets("1")  
shets.Range(stolb & "1") = .[b1].Value
End With  
End If  
Next shets  
   End If  
  Next i  
  Workbooks(iFileName).Close savechanges:=False  
   iFileName = Dir  
Wend  
mypath3 = "C:\ds\"  
   ifilename3 = Dir(mypath3)  
Do While ifilename3 <> ""  
Workbooks.Open (mypath3 + ifilename3)  
a = Mid(ifilename3, 1, 2) & "_.xlsx"  
     ActiveWorkbook.SaveCopyAs "C:\de\" & a  
ifilename3 = Dir  
Loop  
  MyPath1 = "C:\de\"  
   iFileName1 = Dir(MyPath1)  
  While iFileName1 <> ""  
  For j = 2 To 5  
  If iFileName1 = wba.Worksheets("3").Cells(j, 2) Then  
    Workbooks.Open (MyPath1 + iFileName1)  
    For Each shets In wba.Sheets  
    If shets.Name = wba.Worksheets("3").Cells(j, 3) Then  
With ActiveWorkbook.Worksheets("1")  
shets.Range(stolb & "1") = shets.Range(stolb & "1").Value + .[b1].Value
   End With  
   End If  
   Next shets  
   End If  
  Next j  
   iFileName1 = Dir  
Wend  
End Sub

столкнулся с проблемой не работают 2 цикла while вместе, по одному работают нормально ....  
в моей понимание ввыполняется сначала один цикл и начинает выполнятся другой …  
 
Код QBasic/QuickBASIC1  
SUB test()  
DIM MyPath, MyPath1 AS STRING  
   DIM iFileName, iFileName1 AS STRING  
   DIM i, j AS INTEGER  
   DIM wba AS Workbook  
   MyPath = "C:\dr\"  
   iFileName = Dir(MyPath)  
    MyPath1 = "C:\de\"  
   iFileName1 = Dir(MyPath1)  
     
   ON ERROR RESUME NEXT  
   Set wba = ThisWorkbook  
   DO WHILE iFileName <> ""  
  FOR i = 2 TO 5  
  IF iFileName = wba.Worksheets("3").Cells(i, 1) THEN  
    Workbooks.OPEN (MyPath + iFileName)  
     
   END IF  
   NEXT i  
   iFileName = Dir  
   LOOP  
   DO WHILE iFileName1 <> ""  
  FOR j = 2 TO 5  
  IF iFileName1 = wba.Worksheets("3").Cells(j, 1) THEN  
    Workbooks.OPEN (MyPath1 + iFileName1)  
   END IF  
   NEXT j  
   iFileName1 = Dir  
   LOOP  
END SUB

{quote}{login=Юрий М}{date=18.05.2011 11:39}{thema=}{post}У меня работает.  
Sub qqq()  
Dim a As String  
a = "G"  
Range(a & "6").Select  
End Sub{/post}{/quote}  
 
у меня тоже работает ...

{quote}{login=ikki}{date=18.05.2011 11:03}{thema=}{post}не говоря о том, что вы вызываете неизвестную (мне) функцию input и пытаетесь использовать зарезервированное слово As в неположенном месте, строго по названию темы:  
worksheets("a").range(a&"6"){/post}{/quote}  
 
 
не работает так .range(a&"6")

{quote}{login=aser}{date=18.05.2011 11:13}{thema=Re: }{post}{quote}{login=ikki}{date=18.05.2011 11:03}{thema=}{post}не говоря о том, что вы вызываете неизвестную (мне) функцию input и пытаетесь использовать зарезервированное слово As в неположенном месте, строго по названию темы:  
worksheets("a").range(a&"6"){/post}{/quote}  
 
не работает .... range(a&"6")

{quote}{login=ikki}{date=18.05.2011 11:03}{thema=}{post}не говоря о том, что вы вызываете неизвестную (мне) функцию input и пытаетесь использовать зарезервированное слово As в неположенном месте, строго по названию темы:  
worksheets("a").range(a&"6"){/post}{/quote}  
 
спасибо, тут правки нету )

у меня возникла проблема нужно не хочет копироваться, когда имена столбиком задаю как переменную ...  
 
часть кода  
 
dim a as string  
a = input("input") 'ввожу например g  
 
worksheets("a").range("& a &6") = as.worksheets("a").[a1] 'если напишу worksheets("a").range("g6") все нормально ....